Check for active internet connection

╄→尐↘猪︶ㄣ 提交于 2019-12-03 13:38:27
shahkalpesh

You could use MSXML library & use XMLHttpRequest class to check for things

e.g.

On Error Resume Next
Dim request As MSXML2.XMLHTTP60
request.Open "http://www.google.com"
request.Send
Msgbox request.Status

The status will give you HTTP Status code of what happened to the request. You might have to do some more checks, depending on your scenario.

Hope that helps.

Tomalak

Obviously, your problem has many levels. You should start by defining "connected to the internet", and go on with developing fallback strategies that include not writing invalid files on failure.

As for the "am I connected" question, you can try tapping into the Win32 API:

Private Declare Function InternetGetConnectedState Lib "wininet.dll" _
(ByRef dwflags As Long, ByVal dwReserved As Long ) As Long

Public Function GetInternetConnectedState() As Boolean
  GetInternetConnectedState = InternetGetConnectedState(0&,0&)
End Function

Though depending on your network setup (proxy/NAT/firewall restrictions etc.), Windows might have a different opinion about this than you.

Trying to GET the pages you are interested in, checking on the return status in the HTTP headers (gateway timeout, 404, whatever you expect to happen when it "doen't work) might also be a way to go.

Daniel Isoje

Use the following code to check for internet connection first anable XML v6.0 in your references

Function checkInternetConnection() As Integer
'code to check for internet connection
'by Daniel Isoje
On Error Resume Next
 checkInternetConnection = False
 Dim objSvrHTTP As ServerXMLHTTP
 Dim varProjectID, varCatID, strT As String
 Set objSvrHTTP = New ServerXMLHTTP
 objSvrHTTP.Open "GET", "http://www.google.com"
 objSvrHTTP.setRequestHeader "Accept", "application/xml"
 objSvrHTTP.setRequestHeader "Content-Type", "application/xml"
 objSvrHTTP.Send strT
 If err = 0 Then
 checkInternetConnection = True
 Else
  MsgBox "Internet connection not estableshed: " & err.Description & "", 64, "Additt !"
 End If
End Function

Unfortunately, this is a bit of a difficult question to answer for a couple of reasons:

  1. How do you define a non-working internet connection? Do you check for a valid IP address? Do you ping out? How do you know that you have permissions to check these things? How do you know that the computer's firewall/antivirus isn't causing wonky behavior?
  2. Once you've established that the connection is working, what do you do if the connection drops mid-operation?

There are probably ways to do what you want to do, but a lot of "devil's in the details" type things tend to pop up. Do you have any way to check that the saved search is valid? If so, that would probably be the best way to do this.

Building on shakalpesh's answer and the comments to it, there are (at least) two ways to get the web page into Word without parsing the XML returned by the XMLHTTP60 object.

(NB the HTTP status code of 200 indicates that "the request has succeeded" - see here)

  • write the XMLHTTP60.ResponseText out to a text file and then call Documents.Open on that text file
If (xhr.Status = 200) Then
    hOutFile = FreeFile
    Open "C:\foo.html" For Output As #hOutFile
    Print #hOutFile, xhr.responseText
    Close #hOutFile
End If

// ...

Documents.Open "C:\foo.html"

This has the disadvantage that some linked elements may be lost and you'll get a message box when the file opens

  • check the URL status with the XMLHTTP60 object and then use Documents.Open to open the URL as before:
If (xhr.Status = 200) Then
    Documents.Open "http://foo.bar.com/index.html"
End If

There is a slight chance that the XMLHTTP60 request could succeed and the Documents.Open one fail (or vice versa). Hopefully this should be a fairly uncommon event though

I found most answers here and elsewhere confusing or incomplete, so here is how to do it for idiots like me:

'paste this code in at the top of your module (it will not work elsewhere)
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Private Const INTERNET_CONNECTION_MODEM As Long = &H1
Private Const INTERNET_CONNECTION_LAN As Long = &H2
Private Const INTERNET_CONNECTION_PROXY As Long = &H4
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20

'paste this code in anywhere
Function IsInternetConnected() As Boolean
    Dim L As Long
    Dim R As Long
    R = InternetGetConnectedState(L, 0&)
    If R = 0 Then
        IsInternetConnected = False
    Else
        If R <= 4 Then IsInternetConnected = True Else IsInternetConnected = False

    End If
End Function

'your main function/calling function would look something like this
Private Sub btnInternetFunction_Click()
    If IsInternetConnected() = True Then
        MsgBox ("You are connected to the Internet")
        'code to execute Internet-required function here
    Else
        MsgBox ("You are not connected to the Internet or there is an issue with your Internet connection.")
    End If
End Sub

This is what I use. I prefer it because it doesn't require any external references or DLLs.

Public Function IsConnected()
    Dim objFS As Object
    Dim objShell As Object
    Dim objTempFile As Object
    Dim strLine As String
    Dim strFileName As String
    Dim strHostAddress As String
    Dim strTempFolder As String

    strTempFolder = "C:\PingTemp"
    strHostAddress = "8.8.8.8"
    IsConnected = True ' Assume success
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Wscript.Shell")

    If Dir(strTempFolder, vbDirectory) = "" Then
      MkDir strTempFolder
    End If

    strFileName = strTempFolder & "\" & objFS.GetTempName
    If Dir(strFileName) <> "" Then
      objFS.DeleteFile (strFileName)
    End If

    objShell.Run "cmd /c ping " & strHostAddress & " -n 1 -w 1 > " & strFileName, 0, True
    Set objTempFile = objFS.OpenTextFile(strFileName, 1)
    Do While objTempFile.AtEndOfStream <> True
        strLine = objTempFile.Readline
        If InStr(1, UCase(strLine), "REQUEST TIMED OUT.") > 0 Or InStr(1, UCase(strLine), "COULD NOT FIND HOST") > 0 Then
            IsConnected = False
        End If
    Loop
    objTempFile.Close
    objFS.DeleteFile (strFileName)
    objFS.DeleteFolder (strTempFolder)

    ' Remove this after testing.  Function will return True or False
    MsgBox IsConnected
End Function
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!