Jump to content

.vbs (cancel within html)


Recommended Posts

Hi All,

This has bugged me fore some time as i have the (On Error Resume Next) which means everytime i try to cancel the Script it still Loads the next step..

I have a .vbs that run automatically when windows boots..

It loads a couple of programs while displaying a LOADING Splash Screen (which open within IE).

What i need is a way to Ws Quit the Script and close the IE Loading Screen.

But if nothing clicks on the Quit (hyperlink or something) then it just loads as per normal..

EXAMPLE

' 
' Initialize the "Please Wait" window
'
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document

' As it's an Internet Explorer window, we must get rid of the toolbars
'
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.FullScreen = True
oIE.Document.Body.Scroll = "no"
oIE.document.title = "-- LOADING SETTINGS -- Please StandBy........"
'oIE.height=700
'oIE.width=550
oIE.Resizable = False
oIE.Visible = True

' Display HTML within this window with animated Loading Image
'
'## Message 1
'#########################
Dim CountDown : CountDown = 45 ' Total Amount of CountDown Time
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus1 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 40 ' Ready for Next Step
' ******************************
' ** RUN RESTART TIME LOG **
' ******************************
Dim strText
strText = " Restarted: " & strDateLayout 'Eg. Restarted: Sat 03-Nov-2012 -- 03:19 (36 secs)
' Now Append The Restarted Time
Const ForAppending = 8 ' ForAppending = 8 ForReading = 1 ForWriting = 2
Set objTextFile = FSO.OpenTextFile _
(strLOGDirectory & strLOGFile, ForAppending, True)
objTextFile.WriteLine(strText) ' Writes strText every time script Runs
objTextFile.Close
Set sMsg = Nothing

'## Message 2
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus2 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 30 ' Ready for Next Step
' *****************************************
' ** WAITING FOR PRINTER TO INITIATE **
' *****************************************
Set sMsg = Nothing

'## Message 3
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus3 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 0 ' Ready for Next Step

And then it does other stuff..

But what i mainly need is for a Link to show up in the HTML of the Loading Splash Screen to allow the Admin to cancel the Script if Interaction is Required..

Please note i use .vbs not .vb

Thanks..

Link to comment
Share on other sites


If you take out on error you would find out why it not working or you could try this

hta that has a 60 second count down and a graph that works.

Count Down Graph Demo.hta

<!--January-27-13 Hta And Script By Gunsmokingman Aka Jake1Eye This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use. This is only posted as example code and meant only to used as such.--><TITLE>Count Down Graph Demo</TITLE><HTA:APPLICATION ID="CountDownGraph"SCROLL="No"SCROLLFLAT ="No"SingleInstance="Yes"ShowInTaskbar="No"SysMenu="No"MaximizeButton="No"MinimizeButton="No"Border="Thin"BORDERSTYLE ="complex"INNERBORDER ="No"Caption="Yes"WindowState="Normal"APPLICATIONNAME="CntDwnGrph"Icon="%SystemRoot%\explorer.exe"><STYLE type="text/css">Body{Font-Size:9.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;BackGround-Color:#EFE9E3;Margin-Top:25;Margin-Bottom:5;Margin-Left:4;Margin-Right:4;Padding-Top:1;Padding-Bottom:1;Padding-Left:4;Padding-Right:4;Text-Align:Center;Vertical-Align:Top;Border-Top:0px Transparent;Border-Bottom:0px Transparent;Border-Left:0px Transparent;Border-Right:0px Transparent;}BUTTON{Height:15pt;width:60pt;Cursor:Hand;Font:8.05pt;Font-weight:bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:#404040;Text-Align:Center;Vertical-Align:Middle;filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#E5E5E5',EndColorStr='#7D7D7D');Margin:1;Padding:2;Border-Left: 1px Transparent;Border-Right: 2px Transparent;Border-Top: 1px Transparent;Border-Bottom: 2px Transparent;}.pgbar{filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0,StartColorStr='#44DC88',endColorStr='#005a00')}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}</STYLE><script LANGUAGE='VBScript'>'-> Resize And Place In Approx Center Of ScreenDim Wth, Hht :Wth = int(475) :Hht = int(255)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))'-> Runtime VariblesDim Ct, c34, Tm1 :Ct = 60'-> Window OnLoadFunction Window_OnLoad()ProgressBar.style.visibility = ""ProgressBar.style.width = "300"ProgressBar.style.height = "15"Txt1.style.visibility = ""Txt1.style.width = "300"Txt1.style.height = "15"Counter()End Function'-> Count Down FunctionFunction Counter()Dim aIf Len(Ct) = 1 Then Ct = "0" & CtIf Ct = 0 Then'-> Code Here To Do Something When Counter Reaches Zerowindow.clearTimeout(Tm1)window.close()End Ifa = FormatPercent(Ct*15 /300 ,2)a = Replace(a,"%","")a = Replace(a,",","")Txt1.innerHTML= CtProgressBar.style.width = aCt = Ct - 1Tm1=window.setTimeout("Counter()",1000,"VBScript")End Function</SCRIPT><BODY><!-- Uncomment Used To Center The Graph ANd Text<TABLE Width='300' Style='Margin:-2;height:12;' Border='1'><TD Style='Margin:-2;'><DIV ID='' Class='pgbar' Style='width:300'></DIV></TD></TABLE>--><!-- Background Graph --><TABLE Border='1' Style="Filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#ece6e0',endColorStr='#c0bab4');Position:Absolute;Top:9;Left:76;Width:302;Padding:-4pt;"><TD Style='Margin:-2pt;Padding:-4pt;height:13;'></TD></TABLE><!-- Progress Bar --><DIV ID='ProgressBar' Class='pgbar' Style='visibility:hidden;Position:Absolute;Top:10;Left:77;'></DIV><!-- TExt Display On Graph Bar --><DIV ID='Txt1' Style='visibility:hidden;Position:Absolute;Top:11;Left:77;'></DIV><!-- Test Display For User --><TABLE Style='Width;100%;Margin-Top:35pt;'><TD Align='Left'>Some text here with the details of what this does and to alsoinform the user they can cancel and close this HTA.</TD></TABLE><!-- Buttons --><TABLE Style='Width;100%;Margin-Top:5pt;'><TD><BUTTON ID='B01' OnClick='window.clearTimeout(Tm1) :window.close()'>Close</BUTTON></TD></TABLE></BODY>
Link to comment
Share on other sites

I notice at the end of your hta it has the cancel buttons etc.

i don't understand how i can get programs to load in the background like i have in the .vbs?

i'm quite confident so far in working with .vbs but all of my knowledge is self taught so it is hard to change

the skills into a new coding language..

I know a little bit about php but that's about it..

It took me a number of attempts to get the .vbs i have above let alone learning hta..

Any assistance would be greatly appreciated.

What are the main differences between hta & vbs?

I have seen numerous references to hta in the past but never looked into it all that much..

Cheers

Edit: if i can keep the vbs that would be great but just need to know how to get it to cancel the whole script

by clicking a button on the splash screen (IE window that is maximised)..

Edited by drfb
Link to comment
Share on other sites

HTA is just HTML for desktops, I suggest the HTA instead of using CreateObject("InternetExplorer.Application") because

the HTA is easier to work with, fewer restriction from the OS. I used VBS to code the countdown and the graph works

from vbs code.

How make a HTA Goto Full Screen,

Change WindowState="Normal" To WindowState="Maximize"

There is 3 default, Normal, Minimize, Maximize

I suggested this because you can not use WScript with in the CreateObject("InternetExplorer.Application") it a HTML

object that does not support that object.

Here a simple demo using wscript in an hta


<script LANGUAGE='VBScript'>
'-> Resize And Place In Approx Center Of Screen
Dim Wth, Hht :Wth = int(475) :Hht = int(255)
window.ResizeTo Wth, Hht
MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))
Function Test()
wscript.echo "Hello It Works"
End Function
</SCRIPT>
<BODY><BUTTON ID="b01" ONClick="Test()">Test</BUTTON></BODY>

Using the Test Button will produce this error at the start Wscript

post-5386-0-20224600-1359392188_thumb.pn

Link to comment
Share on other sites

  • 4 weeks later...

Cheers for the info. Muchly Appreciated..

I have been playing around with your Script..

How do i get it to open programs etc when the counter gets to a certain # (seconds)?

Also how to get it to display text at a certain #.

I've tried to get it to display using the below by no luck.

If i gave you a copy of my coding (.vbs) do you think you could assist in changing it into .hta?

Link to comment
Share on other sites

1:\ How do i get it to open programs etc when the counter gets to a certain # (seconds)?

You would have to add something like EX Dim Act :Set Act = Createobject("Wscript.Shell") to be

able to run objects. In the Counter function something like this Ex If Ct = 60 Then Do Something

to run or display things at certain points threw the script.

2:\ If i gave you a copy of my coding (.vbs) do you think you could assist in changing it into .hta?

Post your code and I will help you adjust it to work within the HTA. Download the demo I posted

in the above post.

Link to comment
Share on other sites

Apologies if this is a big Code...


' _startup.vbs
' %%% This StartUp Program is Automatically initiated during Windows Startup
'
' @@@@ TO CANCEL THE START-UP PROCESS Alt + F4 Then close Script Error @@@@
'
' ************************
' ** THIS SCRIPT WILL RUN AUTOMATICALLY DURING BOOT UP STAGE..
' ** IT WILL THEN LOG THE TIME THAT COMPUTER WAS RESTARTED & ALL PROGRAMS LOADED..
' ** ONCE LOADED THE LOG FILE WILL BE UPDATED AND EMAILED TO ADMINISTRATOR.
' ************************
' ** HERE WE GO !!! **
' ************************
Dim strDateLayout, strCurrentTime, strCntDwnTimer1, strCntDwnTimer2, strCntDwnHTML1, strCntDwnHTML2, strCntDwnHTML3
Dim strStatus1, strStatus2, strStatus3, strStatus4, strLOGDirectory, strLOGFile
Dim objWshell, oIE, oIEDoc
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objWshell = Wscript.CreateObject("Wscript.Shell")
'
' SETTINGS THAT CAN BE CHANGED
'
strDateLayout = WeekDayName(WeekDay(Now()),1) & " " _
& Right("0" & DatePart("d", Now),2) & "-" _
& MonthName(Month(Now()),1) & "-" _
& DatePart("yyyy", Now) & " -- " _
& FormatDateTime(Now(),vbShortTime) & " (" & Right("0" & DatePart("s", Now),2) & " secs)" ' Sat 03-Nov-2012 -- 03:19 (36 secs)
strCurrentTime = "<b>Time Process Started: </b>" & strDateLayout
strCntDwnTimer1 = "<font size='6'>Approx <font size='7' color='red'><b>"
strCntDwnTimer2 = "</b></font> Seconds Remaining</font>"
strCntDwnHTML1 = "<br> <br> <br> <table align='center'><tr><td align='center'><font size='7'><b>PLEASE WAIT !!!</b></font></td></tr><tr><td> <br><br> </td></tr><tr><td align='center'>"
strCntDwnHTML2 = "</td></tr><tr><td align='center'> <br> </td></tr><tr><td align='center'><font size='5'><b><u>WE ARE CURRENTLY</u></b></font><br><br><b>" '
strCntDwnHTML3 = "</b></td></tr><tr><td align='center'> <br> <br> <br> </td></tr><tr><td align='center'><img height='116' width='505' src='\\localhost\images\LOADING.gif'></td></tr></table>"
strStatus1 = "<font size='5' color='green'>APPENDING THE COMPUTER RESTART TIME TO SYSTEM LOG</font>"
strStatus2 = "<font size='5' color='green'>WAITING FOR PRINTER TO INITIATE</font>"
strStatus3 = "<font size='5' color='green'>SENDING EMAIL TO <font color='blue'>'Administrator'<font color='green'> ADVISING SYSTEM RESTARTED</font>"
strStatus4 = "<font size='5' color='green'>REBOOTING <font color='blue'>000 Nav Turnout System</font>"
strLOGDirectory = "C:\_DRFB_StationPC\Logs\"
strLOGFile = "Shutdown_Restart_LOG.txt"
'
' ##### DO NOT TOUCH ANYTHING BELOW THIS LINE
'
' ************************************************
' ** CHECK CURRENT DATE TO SEE IF BACK-UP OF **
' ** SYSTEM LOG IS REQUIRED. IF SO THEN DO IT **
' ************************************************
On Error Resume Next
Dim strDayNumb, strBkupDate, strFileFolder, strBkupFolder, strFileCLEAN
strDayNumb = Right("0" & DatePart("d", Now),2)
strBkupDate = DatePart("yyyy", Now) & "-" & Right("0" & DatePart("m", Now),2) & "-" & Right("0" & DatePart("d", Now),2) & "_" & Right("0" & Hour(Now),2) & Right("0" & Minute(Now),2) & "." & Right("0" & Second(Now),2) & "sec_"' 2012-11-20_LOGFile.txt
strFileFolder = strLOGDirectory & strLOGFile
strBkupFolder = strLOGDirectory & "_BackUps\"
strFileCLEAN = strBkupFolder & "CLEAN\" & strLOGFile
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If strDayNumb = 01 Then ' Checking for 1st Day of Month
'MsgBox "Today's date is " & strDayNumb & vbCrLf & "Which means we need to BackUp Log File"
'
If FSO.FileExists(strFileFolder) Then
FSO.CopyFile strFileFolder ,strBkupFolder
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
FSO.MoveFile strBkupFolder & strLOGFile ,strBkupFolder & strBkupDate & strLOGFile ' Rename File with Date Appended
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
ErrLOGFile1 = 0
Else
ErrLOGFile1 = 1
End If
If FSO.FileExists(strFileFolder) Then
FSO.DeleteFile strFileFolder
ErrLOGFile2 = 0
Else
ErrLOGFile2 = 1
End If
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
FSO.CopyFile strFileCLEAN ,strLOGDirectory
Else
'MsgBox "Today is not the day to BackUp Logs"
End If
'MsgBox "PROCESS COMPLETE"
'
' ERROR DATA
'
If Err.Number <> 0 Or ErrLOGFile = 1 Or ErrLOGFile2 = 1 Then
' ******************************
' ** ERROR DETAILS IN LOG **
' ******************************
Dim strErrLOGText
strErrLOGText = " ********** " & vbCrLf & "ERR LOGFILE: " & strDateLayout & " == Error Trying to BackUp System Log File - Possible File/Folder Not Exist == " & vbCrLf & "ErrorLOGFile 1 status is " & ErrLOGFile1 & " -- ErrorLOGFile 2 status is " & ErrLOGFile2 & vbCrLf & " *** ERROR IGNORED -- Will Continue To Load *** " & vbCrLf & " ********** " 'Err LogFile: Sat 03-Nov-2012 -- 03:19 (36 secs)
' Now Append The Restarted Time
Const ErrLOGForAppending = 8 ' ForAppending = 8 ForReading = 1 ForWriting = 2
Set objTextFile = FSO.OpenTextFile _
(strLOGDirectory & strLOGFile, ErrLOGForAppending, True)
objTextFile.WriteLine(strErrLOGText) ' Writes strText every time script Runs
objTextFile.Close
End If
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
' ************************
' ** END OF BACK-UP **
' ************************
'
' Initialize the "Please Wait" window
'
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document

' As it's an Internet Explorer window, we must get rid of the toolbars
'
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.FullScreen = True
oIE.Document.Body.Scroll = "no"
oIE.document.title = "-- LOADING SETTINGS -- Please StandBy........"
'oIE.height=700
'oIE.width=550
oIE.Resizable = False
oIE.Visible = True

' Display HTML within this window with animated Loading Image
'
'## Message 1
'#########################
Dim CountDown : CountDown = 45 ' Total Amount of CountDown Time
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus1 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 40 ' Ready for Next Step
' ******************************
' ** RUN RESTART TIME LOG **
' ******************************
Dim strText
strText = " Restarted: " & strDateLayout 'Restarted: Sat 03-Nov-2012 -- 03:19 (36 secs)
' Now Append The Restarted Time
Const ForAppending = 8 ' ForAppending = 8 ForReading = 1 ForWriting = 2
Set objTextFile = FSO.OpenTextFile _
(strLOGDirectory & strLOGFile, ForAppending, True)
objTextFile.WriteLine(strText) ' Writes strText every time script Runs
objTextFile.Close
Set sMsg = Nothing

'## Message 2
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus2 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 30 ' Ready for Next Step
' *****************************************
' ** WAITING FOR PRINTER TO INITIATE **
' *****************************************
Set sMsg = Nothing

'## Message 3
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus3 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 20 ' Ready for Next Step
'
' ERROR DATA
'
On Error Resume Next
'
' **************************************************
' ** LET's SEND EMAIL - To Administrators !!! **
' **************************************************
Dim oName, ODomain, oMyIP, oTo, oSender, oSubject, oTextBody, oAddAttach, oAttachment1, oAttachment2, oAttachment3, oAttachment4, oMsgBox
' Get the computer name
Set WshNetwork = CreateObject("WScript.Network")
oName = WshNetwork.ComputerName
' *****************************
' ** Set Information Below **
' *****************************
'
' Email Domain Name
ODomain = "mydomain.org.au"
' SMTP - Outgoing Email Server
oMyIP = "mail.ourserver.com.au"
' Recipient Email Address {Separate using ; if Multiple Recipients}
oTo = "us@mydomain.org.au"
' Sender Name
oSender = "Main_PC" ' NO SPACES ALLOWED
' Email Subject
oSubject = "Main PC StartUp/Reboot !!"
' Email Text Body {You can have 2 different Views for Emails Sent. Plain Text / HTML which can display as both the same or both completely different.}
oTextBody = "MAIN PC -- StartUp / Reboot" & vbCrLf & vbCrLf & "The Main PC has Rebooted and successfully Loaded"& vbCrLf &"At: " & now & vbCrLf & vbCrLf &"Computer Name: " & oName & vbCrLf & vbCrLf &"You should also receive an E-Mail from { Server } advising of a possible Reason For Reboot (if occurred)."& vbCrLf & vbCrLf &"Attached are System Log Files [Showing STARTUP / RESTART Times]"& vbCrLf & vbCrLf &"Regards,"& vbCrLf &"MAIN PC"& vbCrLf & vbCrLf &" "
oHTMLBody = "<html><body><h1>MAIN PC -- StartUp / Reboot</h1><br>The Main PC has Rebooted and successfully Loaded<br>At: "& now &"<br><br><b>Computer Name:</b> "& oName &"<br><br>You should also receive an E-Mail from { Server } advising of a possible Reason For Reboot (if occurred).<br><br>Attached are System Log Files [Showing STARTUP / RESTART Times]<br><br>Regards,<br>MAIN PC<br> <br> </body></html>"
'
' Email Attachment/s
' 0 = No Email Attachment
' 1 = Includes Email Attachment
oAddAttach1 = 1 ' ## Attachment 1
oAttachment1= strLOGDirectory & strLOGFile
'
oAddAttach2 = 0 ' ## Attachment 2
oAttachment2 = "C:\Document (2).txt"
'
' Message Box
oMsgBox = 0 ' 0 = No Sent MsgBox
' 1 = Display Sent MsgBox
'
' ***************************************
' ** DO NOT CHANGE ANYTHING BELOW HERE **
' ***************************************
'
' Setting the VB constants as they do not exist within VBScript
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing", _
cdoSendUsingPort = 2, _
cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
' Create the CDO connections
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
' SMTP server configuration
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
' Set the SMTP server address here
.Item(cdoSMTPServer) = oMyIP
.Update
End With
' Set the Message properties
With iMsg
Set .Configuration = iConf
.To = oTo
'.CC = "user@domain.com" ' Uncomment this Line (.CC) to enable Carbon Copy
'.BCC = "user@domain.com" ' Uncomment this Line (.BCC) to enable Blind Carbon Copy
.From = oSender & "@" & oDomain
.Subject = oSubject
.TextBody = oTextBody
.HTMLBody = oHTMLBody
End With
' An attachment/s can be included
If oAddAttach1 = 1 then
iMsg.AddAttachment oAttachment1
End If
If oAddAttach2 = 1 then
iMsg.AddAttachment oAttachment2
End If
' Send the message
iMsg.Send
Set iMsg = Nothing
' Confirmation Message Box
If oMsgBox = 1 then
MsgBox "SYSTEM EMAIL SENT"
Else
End If
'
' ERROR DATA
'
If Err.Number <> 0 Then
Set sMsg = Nothing
' ******************************
' ** ERROR DETAILS IN LOG **
' ******************************
Dim strErrText
strErrText = " ********** " & vbCrLf & " ERROR INET: " & strDateLayout & " == Error while trying to send ADMIN Email" & vbCrLf & " *** ERROR -- Possible Internet Not Working " & vbCrLf & " *** ERROR IGNORED -- Will Continue To Load 'Programs' *** " & vbCrLf & " ********** " 'Restarted: Sat 03-Nov-2012 -- 03:19 (36 secs)
' Now Append The Restarted Time
Const ErrForAppending = 8 ' ForAppending = 8 ForReading = 1 ForWriting = 2
Set objTextFile = FSO.OpenTextFile _
(strLOGDirectory & strLOGFile, ErrForAppending, True)
objTextFile.WriteLine(strErrText) ' Writes strText every time script Runs
objTextFile.Close
End If
'
'## Message 4
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus4 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 0 ' Ready for Next Step
' **********************
' ** LOAD PROGRAM **
' **********************
objWshell.run """C:\Folder\File.exe"""
Set sMsg = Nothing

' Time To Close Down The Script and "Please Wait" window
'
Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing

Set objFSO = Nothing
Set objWshell = Nothing
Set WshShell = Nothing

WScript.Quit

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...