CODEWITHSUNDEEP
vbscript
Nate
Nate

Reputation: 75

Check network connection with VBScript

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. Everything works great, as long as there's an internet connection on startup. If there isn't then the page never loads. Is there a way in VBScript to check for a connection every couple minutes until the connection is found, and then continue with the script? Here is the code for your reference:

Option Explicit     
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

Upvotes: 5

Views: 9294

Answers (3)

Shubham Verma
Shubham Verma

Reputation: 9913

Here is the very short code to check your internet connection:

Function isConnectionON()
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Dim isInternetConnected
    isInternetConnected = 0
    Set oShell = WScript.CreateObject("WScript.Shell")
    strHost = "google.com"
    strPingCommand = "ping -n 1 -w 300 " & strHost
    ReturnCode = oShell.Run(strPingCommand, 0 , True)
    If ReturnCode = 0 Then
        isInternetConnected= 1
    Else
        isInternetConnected= 0
    End If
        isConnectionON=isInternetConnected
End Function

Call the function:

isInternetConneted = isConnectionON()
WScript.Echo "isInternetConneted: "&isInternetConneted

Upvotes: 0

Bond
Bond

Reputation: 16311

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

Upvotes: 2

Hackoo
Hackoo

Reputation: 18827

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
'**********************************************************************************************

Upvotes: 3

Related Questions