Обновите список сетей WiFi с помощью 'WlanScan' (преобразовать синтаксис API из C# в vba... или обходной путь?)

Question

Мне нужно обновить список беспроводных сетей Window.

Я с радостью приму любой обходной путь, который я могу автоматизировать (cmdline, wmi и т. Д.) Прямо или косвенно из VBA. (Я использую Windows 7 Home 64-bit с Office 365 Pro 64-bit.)

Я могу перечислить сети программно несколькими способами, включая netsh или приведенный ниже код, но список не обновляется, пока я не нажму физически Значок сетевого подключения в области уведомлений панели задач.

• Список не обновляется автоматически каждые 60 секунд, как указано в некоторых документах.
• Отключение + повторное подключение сетевого адаптера не является осуществимым / устойчивым вариантом.

Я думаю, что я не получаю ручку от WlanOpenHandle как требуется, и я зеленый в преобразовании C в VBA.

Нет ошибок, но WlanScan возвращает неизвестный код 1168,

• Я адаптировался с версии VB здесь: Wlanscan (Wlanapi)
• Документация MSDN: функция WlanScan

---

Связанные биты:

Вот объявление функции для VB , адаптированный:

Public Shared Function WlanScan(ByVal hClientHandle As IntPtr, _
   ByRef pInterfaceGuid As Guid, ByVal pDot11Ssid As IntPtr, _
   ByVal pIeData As IntPtr, ByVal pReserved As IntPtr) As UInteger
End Function

... и пример использования функции в C#:

Guid g;
//wlanHndl is the handle returned previously by calling [WlanOpenHandle]
for (int i = 0; i < infoList.dwNumberOfItems; i++)
{
g = infoList.InterfaceInfo[i].InterfaceGuid;
uint resultCode=WlanScan(wlanHndl, ref g, IntPtr.Zero, IntPtr.Zero, IntPtr.Zero);
if (resultCode != 0)
    return;
}

... и как открыть ручку, в C++ ( отсюда):

dwResult = WlanOpenHandle(dwMaxClient, NULL, &dwCurVersion, &hClient);
if (dwResult != ERROR_SUCCESS) {
    wprintf(L"WlanOpenHandle failed with error: %u\n", dwResult);
    return 1;
    // You can use FormatMessage here to find out why the function failed
}

---

_{"Un-скрытый:"}

Получить (кэшированный) список беспроводных сетей:

Код для перечисления сетей прекрасно работает - за исключением того, что он не обновляется сам по себе. (Ранее я анализировал вывод текста netsh wlan show networks mode=bssid, который имел ту же проблему.)

Ранее я удалил этот раздел, потому что он длинный и работает нормально, за исключением обновления. -)

Option Explicit  'section's source: vbforums.com/showthread.php?632731
Private Const DOT11_SSID_MAX_LENGTH As Long = 32
Private Const WLAN_MAX_PHY_TYPE_NUMBER As Long = 8
Private Const WLAN_AVAILABLE_NETWORK_CONNECTED As Long = 1
Private Const WLAN_AVAILABLE_NETWORK_HAS_PROFILE As Long = 2

Private Type GUID  'from cpearson.com
    Data1 As Long: Data2 As Integer:  Data3 As Integer:  Data4(7) As Byte
End Type

Private Type WLAN_INTERFACE_INFO
    ifGuid As GUID: InterfaceDescription(255) As Byte: IsState As Long
End Type

Private Type DOT11_SSID
    uSSIDLength As Long:            ucSSID(DOT11_SSID_MAX_LENGTH - 1) As Byte
End Type

Private Type WLAN_AVAILABLE_NETWORK
    strProfileName(511) As Byte:    dot11Ssid As DOT11_SSID
    dot11BssType As Long:           uNumberOfBssids As Long
    bNetworkConnectable As Long:    wlanNotConnectableReason As Long
    uNumberOfPhyTypes As Long:      dot11PhyTypes(WLAN_MAX_PHY_TYPE_NUMBER - 1) As Long
    bMorePhyTypes As Long:          wlanSignalQuality As Long
    bSEcurityEnabled As Long:       dot11DefaultAuthAlgorithm As Long
    dot11DefaultCipherAlgorithm As Long: dwflags As Long: dwReserved As Long
End Type

Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberOfItems As Long: dwIndex As Long: InterfaceInfo As WLAN_INTERFACE_INFO
End Type

Private Type WLAN_AVAILABLE_NETWORK_LIST
    dwNumberOfItems As Long:  dwIndex As Long: Network As WLAN_AVAILABLE_NETWORK
End Type

Declare PtrSafe Function WlanOpenHandle Lib "Wlanapi.dll" (ByVal dwClientVersion As Long, _
                ByVal pdwReserved As Long, ByRef pdwNegotiaitedVersion As Long, _
                ByRef phClientHandle As Long) As Long

Declare PtrSafe Function WlanEnumInterfaces Lib "Wlanapi.dll" (ByVal hClientHandle As Long, _
                ByVal pReserved As Long, ppInterfaceList As Long) As Long

Declare PtrSafe Function WlanGetAvailableNetworkList Lib "Wlanapi.dll" ( _
                ByVal hClientHandle As Long, pInterfaceGuid As GUID, ByVal dwflags As Long, _
                ByVal pReserved As Long, ppAvailableNetworkList As Long) As Long

Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                Source As Any, ByVal Length As Long)

Declare PtrSafe Sub WlanFreeMemory Lib "Wlanapi.dll" (ByVal pMemory As Long)

Type WiFis
  ssid As String: signal As Single
End Type

Public Function GetWiFi() As WiFis()
'returns an array of custom type WiFis (1st interface only)

    Dim udtList As WLAN_INTERFACE_INFO_LIST, udtAvailList As WLAN_AVAILABLE_NETWORK_LIST, udtNetwork As WLAN_AVAILABLE_NETWORK
    Dim lngReturn As Long, lngHandle As Long, lngVersion As Long, lngList As Long, lngAvailable As Long
    Dim lngStart As Long, intCount As Integer, ssid As String, signal As Single, wifiOut() As WiFis
    n = 0

    lngReturn = WlanOpenHandle(2&, 0&, lngVersion, lngHandle) 'get handle
    If lngReturn <> 0 Then
        Debug.Print "Couldn't get wlan handle (Code " & lngReturn & ")"
        Exit Function
    End If

    lngReturn = WlanEnumInterfaces(ByVal lngHandle, 0&, lngList) 'enumerate <*first interface only*>
    CopyMemory udtList, ByVal lngList, Len(udtList)
    lngReturn = WlanGetAvailableNetworkList(lngHandle, udtList.InterfaceInfo.ifGuid, 2&, 0&, lngAvailable) 'get network list
    CopyMemory udtAvailList, ByVal lngAvailable, LenB(udtAvailList)
    intCount = 0
    lngStart = lngAvailable + 8

    Do
        CopyMemory udtNetwork, ByVal lngStart, Len(udtNetwork) ' Populate avail. network structure
        ssid = Replace(StrConv(udtNetwork.dot11Ssid.ucSSID, vbUnicode), Chr(0), "")
        If Len(ssid) < 4 Then ssid = "(Unnamed)"
        signal = CSng(udtNetwork.wlanSignalQuality) / 100
        '[Signal] = 0 to 100 which represents the signal strength (100 Signal)=(-100dBm RSSI), (100 Signal)=(-50dBm RSSI)

        If udtNetwork.dwflags = 0 Then
            n = n + 1
            ReDim Preserve wifiOut(n)
            wifiOut(n).ssid = ssid
            wifiOut(n).signal = signal
        Else
            'skipping networks with [dwflags] > 0
            'I *think* that's what I'm supposed to do
            'Returns 3 for currently connected network, 2 for networks that have profiles
        End If

        intCount = intCount + 1
        lngStart = lngStart + Len(udtNetwork)
    Loop Until intCount = udtAvailList.dwNumberOfItems
    WlanFreeMemory lngAvailable     'clean up memory
    WlanFreeMemory lngList

    GetWiFi = wifiOut   'Success! (function is populated with cached network list)

End Function

---

_{... и проблема:}

Обновить список сетей, используя WlanScan?

Это не генерирует ошибку VBA, но действительно возвращает код 1168 (который я не могу определить)/ ( Источник)

'Added blindly:'wlanui type library (wlanui.dll) and "wlan pref iua" (wlanconn.dll)

Public Type DOT11_SSID 
   uSSIDLength As LongPtr: ucSSID As String
End Type

Private Type GUID 'from cpearson.com/excel/CreateGUID.aspx
    Data1 As LongPtr: Data2 As Integer
    Data3 As Integer: Data4(0 To 7) As Byte
End Type

#If Win64 Then 'also new to Office-64bit, but seems okay
    Declare PtrSafe Function WlanScan Lib "Wlanapi.dll" _
        (ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, _
        ByVal pDot11Ssid As LongPtr, ByVal pIeData As LongPtr, _
        ByVal pReserved As LongPtr) As LongPtr
#Else
    Private Declare WlanScan Lib "Wlanapi.dll" _
        (ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, _
        ByVal pDot11Ssid As LongPtr, ByVal pIeData As LongPtr, _
        ByVal pReserved As LongPtr) As LongPtr
#End If

Sub test_RefreshNetworkList()
    Dim hresult As LongPtr, phClientHandle As Long, pdwNegotiatedVersion As Long
    Dim retVal As Longptr, g As GUID
    hresult = WlanOpenHandle(2&, 0&, pdwNegotiatedVersion, phClientHandle)
    retVal = WlanScan(phClientHandle, g, 0, 0, 0)
    Select Case retVal
        Case 87: Debug.Print "ERROR_INVALID_PARAMETER"
        Case 6: Debug.Print "ERROR_INVALID_HANDLE"
        Case 8: Debug.Print "ERROR_NOT_ENOUGH_MEMORY"
        Case Else: Debug.Print "RPC_STATUS : " & retVal  ' "misc errors"
    End Select
End Sub

---

Конечно, есть обходной способ обновить список сетей из VBA? Я крут с обходными путями, которые я могу автоматизировать... что-нибудь?!

Спасибо!

---

Редактировать:

Я изменился Long в LongPtr в соответствующих (я думаю) местах. Та же ошибка

Вот WlanOpenHandle а также WlanScan определения.

Declare PtrSafe Function WlanOpenHandle Lib "Wlanapi.dll" 
    (ByVal dwClientVersion As LongPtr, _
     ByVal pdwReserved As LongPtr, 
     ByRef pdwNegotiaitedVersion As LongPtr, _
     ByRef phClientHandle As LongPtr           ) As LongPtr

(... это была моя первая попытка использовать константы компилятора.)

#If Win64 Then
    Declare PtrSafe Function WlanScan Lib "Wlanapi.dll" _
        (ByVal hClientHandle As LongPtr,
         ByRef pInterfaceGuid As GUID, _
         ByVal pDot11Ssid As LongPtr, 
         ByVal pIeData As LongPtr, _
         ByVal pReserved As LongPtr) As LongPtr
#Else
    Private Declare WlanScan Lib "Wlanapi.dll" _
        (ByVal hClientHandle As LongPtr, 
         ByRef pInterfaceGuid As GUID, _
         ByVal pDot11Ssid As LongPtr, 
         ByVal pIeData As LongPtr, _
         ByVal pReserved As LongPtr     ) As LongPtr
#End If

Answer 1

Я думаю, что ваша главная проблема с неосвежающим состоянием - это то, что вы никогда не закрываете открытые ручки Это может вызвать проблемы, так как не должно быть нескольких открытых дескрипторов.

Ты используешь WlanOpenHandle чтобы получить представление об интерфейсе, но после того, как вы поработаете с ним и получите необходимую информацию, вам следует позвонить WlanCloseHandle закрыть эту ручку и связанное соединение.

Declare PtrSafe Function WlanCloseHandle Lib "Wlanapi.dll" ( _
  ByVal hClientHandle As LongPtr, _
  Optional ByVal pReserved As LongPtr) As Long

И в конце вашей функции:

    WlanCloseHandle lngHandle 'Close handle
    GetWiFi = wifiOut   'Success! (function is populated with cached network list)
End Function

Любой обработчик ошибок, если вы собираетесь добавить его, должен проверить, равен ли он 0, а если нет, закройте его.

Я также изменил различные мелочи, такие как использование LongPtr чтобы указатели делали ваш код 64-битным совместимым (примечание: он не совместим с VBA6, что требует много условных компиляций), переработкой ваших объявлений, чтобы не использовать необязательные параметры, и некоторыми другими мелочами.

Я протестировал следующий код с 10 итерациями на устройстве и получил 10 разных результатов:

Код:

Public Function GetWiFi() As wifis()
'returns an array of custom type WiFis (1st interface only)

    Dim udtList As WLAN_INTERFACE_INFO_LIST, udtAvailList As WLAN_AVAILABLE_NETWORK_LIST, udtNetwork As WLAN_AVAILABLE_NETWORK
    Dim lngReturn As Long, pHandle As LongPtr, lngVersion As Long, pList As LongPtr, pAvailable As LongPtr
    Dim pStart As LongPtr, intCount As Integer, ssid As String, signal As Single, wifiOut() As wifis
    Dim n As Long
    n = 0

    lngReturn = WlanOpenHandle(2&, 0&, lngVersion, pHandle) 'get handle
    If lngReturn <> 0 Then
        Debug.Print "Couldn't get wlan handle (Code " & lngReturn & ")"
        Exit Function
    End If

    lngReturn = WlanEnumInterfaces(ByVal pHandle, 0&, pList) 'enumerate <*first interface only*>
    CopyMemory udtList, ByVal pList, Len(udtList)
    lngReturn = WlanScan(pHandle, udtList.InterfaceInfo.ifGuid)
    lngReturn = WlanGetAvailableNetworkList(pHandle, udtList.InterfaceInfo.ifGuid, 2&, 0&, pAvailable) 'get network list
    CopyMemory udtAvailList, ByVal pAvailable, LenB(udtAvailList)
    intCount = 0
    pStart = pAvailable + 8

    Do
        CopyMemory udtNetwork, ByVal pStart, Len(udtNetwork) ' Populate avail. network structure
        ssid = Replace(StrConv(udtNetwork.dot11Ssid.ucSSID, vbUnicode), Chr(0), "")
        If Len(ssid) < 4 Then ssid = "(Unnamed)"
        signal = CSng(udtNetwork.wlanSignalQuality) / 100
        '[Signal] = 0 to 100 which represents the signal strength (100 Signal)=(-100dBm RSSI), (100 Signal)=(-50dBm RSSI)

        If udtNetwork.dwflags = 0 Then
            n = n + 1
            ReDim Preserve wifiOut(n)
            wifiOut(n).ssid = ssid
            wifiOut(n).signal = signal
        Else
            'skipping networks with [dwflags] > 0
            'I *think* that's what I'm supposed to do
            'Returns 3 for currently connected network, 2 for networks that have profiles
        End If

        intCount = intCount + 1
        pStart = pStart + Len(udtNetwork)
    Loop Until intCount = udtAvailList.dwNumberOfItems
    WlanFreeMemory pAvailable     'clean up memory
    WlanFreeMemory pList
    WlanCloseHandle pHandle 'Close handle
    GetWiFi = wifiOut   'Success! (function is populated with cached network list)
End Function

Типы и константы:

Private Const DOT11_SSID_MAX_LENGTH As Long = 32
Private Const WLAN_MAX_PHY_TYPE_NUMBER As Long = 8
Private Const WLAN_AVAILABLE_NETWORK_CONNECTED As Long = 1
Private Const WLAN_AVAILABLE_NETWORK_HAS_PROFILE As Long = 2

Public Type GUID
    Data(15) As Byte
End Type

Private Type WLAN_INTERFACE_INFO
    ifGuid As GUID: InterfaceDescription(255) As Byte: IsState As Long
End Type

Private Type DOT11_SSID
    uSSIDLength As Long:            ucSSID(DOT11_SSID_MAX_LENGTH - 1) As Byte
End Type

Private Type WLAN_AVAILABLE_NETWORK
    strProfileName(511) As Byte:    dot11Ssid As DOT11_SSID
    dot11BssType As Long:           uNumberOfBssids As Long
    bNetworkConnectable As Long:    wlanNotConnectableReason As Long
    uNumberOfPhyTypes As Long:      dot11PhyTypes(WLAN_MAX_PHY_TYPE_NUMBER - 1) As Long
    bMorePhyTypes As Long:          wlanSignalQuality As Long
    bSEcurityEnabled As Long:       dot11DefaultAuthAlgorithm As Long
    dot11DefaultCipherAlgorithm As Long: dwflags As Long: dwReserved As Long
End Type

Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberOfItems As Long: dwIndex As Long: InterfaceInfo As WLAN_INTERFACE_INFO
End Type

Private Type WLAN_AVAILABLE_NETWORK_LIST
    dwNumberOfItems As Long:  dwIndex As Long: Network As WLAN_AVAILABLE_NETWORK
End Type

Public Type WiFis
  ssid As String: signal As Single
End Type

Объявления функций:

Declare PtrSafe Function WlanOpenHandle Lib "Wlanapi.dll" (ByVal dwClientVersion As Long, _
                ByVal pdwReserved As LongPtr, ByRef pdwNegotiaitedVersion As Long, _
                ByRef phClientHandle As LongPtr) As Long

Declare PtrSafe Function WlanEnumInterfaces Lib "Wlanapi.dll" (ByVal hClientHandle As LongPtr, _
                ByVal pReserved As LongPtr, ByRef ppInterfaceList As LongPtr) As Long

Declare PtrSafe Function WlanGetAvailableNetworkList Lib "Wlanapi.dll" ( _
                ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, ByVal dwflags As Long, _
                ByVal pReserved As LongPtr, ByRef ppAvailableNetworkList As LongPtr) As Long


Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                Source As Any, ByVal Length As Long)

Declare PtrSafe Function WlanScan Lib "Wlanapi.dll" _
        (ByVal hClientHandle As LongPtr, ByRef pInterfaceGuid As GUID, _
        Optional ByVal pDot11Ssid As LongPtr, Optional ByVal pIeData As LongPtr, _
        Optional ByVal pReserved As LongPtr) As Long

Declare PtrSafe Function WlanCloseHandle Lib "Wlanapi.dll" ( _
  ByVal hClientHandle As LongPtr, _
  Optional ByVal pReserved As LongPtr) As Long


Declare PtrSafe Sub WlanFreeMemory Lib "Wlanapi.dll" (ByVal pMemory As LongPtr)

Тестовый звонок для распечатки списка:

Public Sub PrintWifis()
    Dim aWifis() As wifis
    aWifis = GetWiFi
    Dim l As Long
    For l = LBound(aWifis) To UBound(aWifis)
        Debug.Print aWifis(l).ssid; aWifis(l).signal
    Next
End Sub

Answer 2

Что касается этих комментариев:

список не обновляется, если я физически не нажимаю значок сетевого подключения

а также

Конечно, есть обходной способ обновить список сетей из VBA? Я крут с обходными путями, которые я могу автоматизировать... что-нибудь?!

Вот обходной путь: программно щелкните значок сетевого подключения:

Sub ClickIt()
With CreateObject("WScript.Shell")
    .Run "%windir%\explorer.exe ms-availablenetworks:"
End With
End Sub

Вы можете "закрыть" его с помощью mouse_event после application.wait, когда для обновления потребуется некоторое время

Answer 3

Этот проект стал миссией, потому что он казался простым, несколько раз. Моя первая попытка захватила вывод netsh wlan show networks mode=bssid но я не мог получить список, чтобы обновить. Думая, что обновление будет легко, если я перейду на метод API (WlanScan + WlanGetAvailableNetworkList), Я начал с нуля, прежде чем понял, что все еще не могу обновить данные.

После публикации этого вопроса ответ EvR в конечном итоге / наконец привел меня к возможности открывать / закрывать список сетевых подключений в области уведомлений Windows, в котором обновлялся кэшированный текст, поэтому я переписал процесс в третий раз, вернувшись к использованию netsh, Я наконец получил попытку № 3 работать (ниже), а затем увидел ответ Эрика, который дает тот же результат... но значительно менее "хакерский" и в 25 раз быстрее.

Итак, я, конечно, пойду с "последней попыткой № 4", но решил, что в любом случае опубликую этот альтернативный ответ, так как некоторые концепции легко переносятся на другие проблемы, когда быстрое мотыга исправить нужно.

Option Compare Binary
Option Explicit

Public Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (ByVal hWnd _
    As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters _ 
    As String, ByVal lpDirectory As String, ByVal nShowCmd As LongPtr) As LongPtr
Public Declare Function GetWindowText Lib "User32.dll" Alias "GetWindowTextA" _
    (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As LongPtr
Public Declare Function GetForegroundWindow Lib "User32.dll" () As LongPtr

Type WiFis
    ssid As String      'wifi network name
    signal As Single    'wifi signal strength%
End Type

Private Function IsNetworksWindow(hWnd As Long, nCaption As String) As Boolean
'returns TRUE if the window caption (title) of window [hWnd]=[nCaption]
    Dim title As String * 255
    GetWindowText hWnd, title, 255                                  'get window caption
    IsNetworksWindow = (nCaption = Left$(title, Len(nCaption)))
End Function

Sub RefreshWifiList()
'open "available networks" window (to refresh cached network list)
    Const clsID = "shell:::{38A98528-6CBF-4CA9-8DC0-B1E1D10F7B1B}" 'clsid of req'd window
    Const nCaption = "View Available Networks"                     'title of req'd  window
    Dim retVal As LongPtr
    retVal = ShellExecute(0, "open", clsID, "", "", 0)             'open clsID
    If retVal < 33 Then Stop    'Error. Full list here: [http://oehive.org/node/528]
    Do
    DoEvents: Loop While Not IsNetworksWindow(GetForegroundWindow, nCaption) 'wait for refresh
    ThisWorkbook.Activate: AppActivate Application.Caption           'return to Excel
End Sub

Public Function getCmdLineOutput(cmd As String) As String
'run cmdline in hidden window and return string of output
    Dim tmpFile As String: tmpFile = Environ("temp") & "\cmd_out.tmp" 'create tmp file
    If Dir(tmpFile) <> "" Then Kill tmpFile                         'delete tmp file
    With CreateObject("WScript.Shell")                              'run cmdline command
        .Run "cmd /c """ & cmd & """ > " & tmpFile, 0, True         '0=Hide Window
    End With
    With CreateObject("Scripting.FileSystemObject")                 'open fso
        getCmdLineOutput = Trim(.opentextfile(tmpFile).ReadAll())   'read temp file
        .DeleteFile tmpFile                                         'delete temp file
    End With
End Function

Public Function GetWiFi() As WiFis()
'extract [ssid]'s & [signal]'s from list to populate array of networks
    Dim stNet As String, pStart As Long, pStop As Long: pStop = 1
    Dim ssid As String, signal As String, wiFi() As WiFis: ReDim wiFi(0 To 0)

    Application.ScreenUpdating = False
    RefreshWifiList                                                 'refresh wifi list
    stNet = getCmdLineOutput("netsh wlan show networks mode=bssid") 'get network list
    stNet = Mid$(stNet, InStr(stNet, "SSID"))                       'trim extraneous chars
    stNet = Replace(Replace(Replace(stNet, " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)

    Do While InStr(pStop, stNet, "SSID") > 0
        pStart = InStr(InStr(pStop, stNet, "SSID"), stNet, ":") + 1   'find ssid start
        pStop = InStr(pStart, stNet, "Networktype")                   'find ssid stop
        ssid = Mid$(stNet, pStart, pStop - pStart)                    'extract ssid
        pStart = InStr(pStop, stNet, "Signal:") + 7                   'find signal start
        pStop = InStr(pStart, stNet, "%")                             'find signal stop
        signal = CSng(Mid$(stNet, pStart, pStop - pStart)) / 100      'extract signal
        If signal = 0 Then Stop: If ssid = "" Then ssid = "(Unnamed)" 'validate

        ReDim Preserve wiFi(UBound(wiFi) + 1)                         'populate array
        wiFi(UBound(wiFi)).ssid = ssid: wiFi(UBound(wiFi)).signal = signal
    Loop

    GetWiFi = wiFi
End Function

Sub demo()
    Dim wiFi() As WiFis, netNum As Long
    wiFi() = GetWiFi()                                      'populate array of networks
    For netNum = 1 To UBound(wiFi)                          'loop through networks
        With wiFi(netNum)
            Debug.Print .ssid, Format(.signal, "0%")        'print ssid & signal
        End With
    Next netNum
End Sub

Sub timeTest_listNetworks()
    Dim wiFi() As WiFis, netNum As Long, n As Long
    Dim startTime As Single, allTime As Single: allTime = Timer
    For n = 1 To 5                      'repeat test 5x
        Erase wiFi()                    'clear array
        startTime = Timer
        wiFi() = GetWiFi()              'refresh array of networks
        For netNum = 1 To UBound(wiFi)  'loop through networks
            Debug.Print wiFi(netNum).ssid & "=" & Format(wiFi(netNum).signal, "0%") & " ";
        Next netNum
        Debug.Print "(" & Round(Timer - startTime, 1) & " sec)"
    Next n
    Debug.Print "Total: " & Round(Timer - allTime, 1) & " sec"
End Sub

---

Дополнительная информация:

• Джефф Чаппелл: Explorer Командная строка
• MS Docs: ShellExecuteA функция
• OpenEdge: ShellExecute коды возврата
• MS Docs: GetWindowTextA функция
• MS Docs: GetForegroundWindow функция
• SS64: WScript.Shell.Run метод
• MS Docs: Сценарии FileSystemObject.OpenTextFile метод
• MS Docs: AppActivate утверждение
• Переполнение стека: преобразование уровня сигнала% в RSSI дБм