Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 272
  • Last Modified:

MS Access VBA--Check if there's an internet connection.

I made an Access 2013 program which uses MS Azure for the SQL backend.  

Before a report (or other functions) is executed the code was checking to make sure there was a connection to the internet by using InternetGetConnectedState(0&, 0&).  I thought this was a good solution but discovered that this code only works if you unplug the Ethernet cable from your computer or disable the wireless in the "Network Connections."  

In other words when the internet went down the above code would give a false positive that there was still internet connectivity because I was still connected to my router.  And with no internet access the report locks up because it can't communicate with Azure.

So I need VBA code to check in the background if the internet is available, maybe a simple ping to www.msn.com.  If "true" then I can let the report execute, if "false" then a msgbox would tell the user that the internet is down.

Thanks!!!
0
steve lemmon
Asked:
steve lemmon
  • 6
  • 4
  • 2
1 Solution
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
This:

http://www.freevbcode.com/ShowCode.asp?ID=199

 Has a ping function.   Although it's in VB6, it should drop right into VBA.

 Let me know if you have any issues with it.

Jim.
0
 
Gustav BrockCIOCommented:
Hmm, just a link to a remote site with downloads as an answer - I've been bashed for that ...

/gustav
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
Just a note that I tried the ping function in that lib and it worked fine.   I only had to comment out one call to the App.Logevent:

Private Sub SocketsCleanup()
   
If WSACleanup() <> ERROR_SUCCESS Then
    'App.LogEvent "Socket error occurred in Cleanup.", vbLogEventTypeError
End If

End Sub

I know it's solid to because this is the same ping routine included with vbSendMail, which has been used for years.

But do note that using a ping is not always reliable as many sites don't accept ping requests, so make sure you pick a site that does allow for pings.

Jim.
0
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
@gustav,

<<Hmm, just a link to a remote site with downloads as an answer - I've been bashed for that ...>>

 Depends on the site and if you add anything to it.  In this case, it's not another Q&A site, and I indicated that I knew it had what they needed.

Jim.
0
 
steve lemmonAuthor Commented:
Jim, thanks but even when I comment out the above there are more than 400 lines left.  Can you just copy a minimum amount and paste them here.  I just need the code to see if there's something out there beyond the router.  Many thanks.
0
 
Gustav BrockCIOCommented:
That's what I was told. A link is not an answer.

/gustav
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
<<That's what I was told. A link is not an answer.>>

 That is not true.  In most cases it is not, but there are occasions where a straight forward question is asked, and the best way to answer it is with a link and some commentary.

 What's frowned upon is answering a question with "this might help" and a link or in other words, a shot in the dark.

 Send me a PM with the question where this happened if you can remember it and I'll have a look at it.  I can then follow-up with whoever.

Jim.
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
Attached is a sample database.    It has a single module in it.   Import the module into your DB.

 Then where you need a ping:

 Dim  lngRet as long

 lngRet = Ping("www.somewebsiteorhost.com","",False)

 If lngRet <> 0 then
    msgbox "Can't reach www.somewebsiteorhost.com", vbExclamimation + vbOKOnly,""
End If

Jim.
TCPIP.accdb
0
 
steve lemmonAuthor Commented:
Works like a charm!!!  It's very quick and accurate.  

Anyone who uses Access with a cloud backend such as Azure, SharePoint, or any other should use this solution.  

Many thanks to Jim Dettman.
0
 
steve lemmonAuthor Commented:
Upon using the accepted solution for a while I started getting "false negatives," meaning the code would tell me the internet is down when it wasn't.  I thought that maybe it had something to do with the ping response time so I did 2 things.

First I was pinging www.yahoo.com but found that www.msn.com responds about twice as fast.
Second I delayed the code a quarter second by inserting the indented code.  Since then I haven't had a problem.  If I have problems in the future I'll try increasing the pause time a little.

    Dim lngRet As Long
    lngRet = Ping("www.msn.com", "", False)
        Dim PauseTime, Start
        PauseTime = 0.25 ' Set duration in seconds
        Start = Timer ' Set start time.
        Do While Timer < Start + PauseTime
        DoEvents ' Yield to other processes.
        Loop
    If lngRet <> 0 Then 'no internet connection
    MsgBox "This function does not work when the internet is down."
    Exit Sub
    End If
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
Steve,

 The loop there is doing nothing.   You can take it out.  The variable lngRet is already set.   Doesn't matter how long you wait.

 <<Upon using the accepted solution for a while I started getting "false negatives," meaning the code would tell me the internet is down when it wasn't. >>

  Relying on a Ping is problematic.   Not all sites return a ping and some routers/firewalls might start blocking a port if it sees repeated requests.  There are also transient internet problems where you might not reach a particular site.  Your also relying on DNS and there could be issues with that.   So what I would do is this:

    lngRet = Ping("www.msn.com", "", False)
    If lngRet <> 0 Then
        lngRet = Ping("www.google.com", "", False)
        If lngRet <> 0 Then
          lngRet = Ping("www.someothermajorsite.com", "", False)
          If lngRet <> 0 Then
            MsgBox "This function does not work when the internet is down."
          End If
       End If
    End If

If after attempting to ping three sites that normally take ping requests, then something is wrong.    

Jim.

PS. and no need to PM me if you post a comment here....I get a notification.
0
 
steve lemmonAuthor Commented:
Your updated code is awesome.  I am very grateful and will be using it.

I embellished it slightly for testing purposes only.  Since CenturyLink is my ISP I decided to make it the primary ping.  (Don't put an IP in for the URLs below...it will give you a false positive.)

Dim lngRet As Long
  lngRet = Ping("www.centurylink.com", "", False)
    If lngRet <> 0 Then
     lngRet = Ping("www.google.com", "", False)
        If lngRet <> 0 Then
            lngRet = Ping("www.msn.com", "", False)
            If lngRet <> 0 Then
                MsgBox "Internet down."
            Else
                MsgBox "Internet on MSN.com"
            End If
        Else
            MsgBox "Internet on Google.com"
        End If
    Else
        MsgBox "Internet on CenturyLink.com"
    End If
0

Featured Post

NFR key for Veeam Agent for Linux

Veeam is happy to provide a free NFR license for one year.  It allows for the non‑production use and valid for five workstations and two servers. Veeam Agent for Linux is a simple backup tool for your Linux installations, both on‑premises and in the public cloud.

  • 6
  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now