Определите, подключен ли к VPN, Office Intranet или Office Wifi с помощью Excel VBA - PullRequest
Новая
       36

Определите, подключен ли к VPN, Office Intranet или Office Wifi с помощью Excel VBA

1 голос
/ 01 ноября 2019

У меня есть следующий код, с помощью которого я успешно проверяю, подключен ли я к 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

Но если я нахожусь в офисе компании и подключен к интрасети по локальной сетиКабель или офис WIFI, мне не нужно подключаться к VPN. Таким образом, я не могу заставить мой код работать.

Я попробовал следующее, но не дал правильных результатов:

  • objItem.ServiceName
  • objItem.DNSDomain

Так что objItem properties определит, что я уже подключен к интрасети через Office Wifi или Office LAN. например, свойства для определения State и type of Adapter, к которым я подключен, т. е. Wifi, Ethernet и т. д.?

1 Ответ

1 голос
/ 02 ноября 2019

Не возможно ли пинговать сервер? Если вы находитесь в офисе или подключены через VPN, он должен ответить на пинг. Если вы не подключены, он не ответит. 

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
...