Determine if connected to VPN or Office Intranet or Office Wifi using excel vba

Question

I have the following code with which i am successfully checking if i am connected to VPN from home to access company network folders.

Sub doit()
    If ConnectedToVPN Then
    ' run other code to access network folders and files...
    End if
End Sub


Function ConnectedToVPN() As Boolean
   Dim sComputer$, oWMIService, colItems, objItem

   ConnectedToVPN = False
   sComputer = "."

   Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2")
   Set colItems = oWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration", , 48)

    'Please check description of your VPN Connection by running command "ipconfig /all" on command-line.

    For Each objItem In colItems
        If (InStr(LCase(objItem.Description), "vpn")) Then
            ConnectedToVPN = objItem.IPEnabled
        End If
    Next objItem

    If (ConnectedToVPN) Then ConnectedToVPN = True

End Function

But if i am in company office and connected to intranet using LAN cable or office WIFI, i don't need to connect to VPN. This way, i cannot make my code work.

I tried the following but not giving me correct results:

• objItem.ServiceName
• objItem.DNSDomain

So what objItem properties would determine that i am already connected to intranet via either an Office Wifi or Office LAN. e.g. properties to determine State and type of Adapter to which i am connected i.e. whether Wifi, Ethernet etc?

Answer 1

Wouldn't it be possible to ping the server? If you are at the office or connected through VPN it should answer a ping. If you aren't connected, it won't answer.

Dim PingResults As Object
Dim PingResult As Variant
Dim Query As String
Dim Host As String

Host = "YourFileServerHostName"
Query = "SELECT * FROM Win32_PingStatus WHERE Address = '" & Host & "'"

Set PingResults = GetObject("winmgmts://./root/cimv2").ExecQuery(Query)

For Each PingResult In PingResults
    If Not IsObject(PingResult) Then
        Ping = False
    ElseIf PingResult.StatusCode = 0 Then
        Ping = True
    Else
        Ping = False
    End If
Next