I\'m running a web-based slideshow on multiple computer units. I have a VBScript that runs on startup, opens IE and navigates to a specific page in fullscreen mode. Everythi
Refer to this ==> Loop a function?
Yes, you can do it easily with this code :
Option Explicit
Dim MyLoop,strComputer,objPing,objStatus
MyLoop = True
While MyLoop = True
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
Call MyProgram()
wscript.quit
End If
Next
Pause(10) 'To sleep for 10 secondes
Wend
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub MyProgram()
Dim WshShell
set WshShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
With WScript.CreateObject ("InternetExplorer.Application")
.Navigate "http://www.example.com/slideshow"
.fullscreen = 1
.Visible = 1
WScript.Sleep 10000
End With
On Error Goto 0
End Sub
'**********************************************************************************************
If Hackoo's code doesn't work for you, you can try the following. Not all servers will respond to ping requests but you could just make an HTTP request and see if the server sends a valid response (status = 200).
Function IsSiteReady(strURL)
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", strURL, False
.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.1)"
On Error Resume Next
.Send
If .Status = 200 Then IsSiteReady = True
End With
End Function