使用 excel vba 确定是否连接到 VPN 或 Office Intranet 或 Office Wifi

Question

我有以下代码可以成功检查我是否从家里连接到 VPN 以访问公司网络文件夹。

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

但是如果我在公司办公室并且使用LAN电缆或办公室WIFI连接到Intranet，我不需要连接到VPN。这样，我无法使我的代码工作。

我尝试了以下但没有给出正确的结果：

objItem.ServiceName
objItem.DNSDomain

那么 objItem properties 会确定我已经通过 Office Wifi 或 Office LAN 连接到 Intranet。例如确定我所连接的 State 和 type of Adapter 的属性，即是否 Wifi、Ethernet 等？

Answer 1

难道不能ping通服务器吗？如果您在办公室或通过 VPN 连接，它应该响应 ping。如果您未连接，它将不会接听。

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

使用 excel vba 确定是否连接到 VPN 或 Office Intranet 或 Office Wifi

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

excel

vpn

wmi

wireless

vba