Scraping data from WIFI networks that are available

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
4,546
Office Version
  1. 2007
Platform
  1. Windows
Ultimately, I would like to combine the results from the following onto one sheet:

1) CreateObject("WScript.Shell").Run "cmd /c netsh wlan show networks mode=BSSID" & _
"|clip""", 0, True
specifically:
SSID, Networktype, Authentication, Encryption, MAC Address (BSSID), Signal level, Radiotype, Band, & Channel ... I have the code to do this :)

2) Data scraped from WLAN_AVAILABLE_NETWORK
specifically:
uNumberOfBssids, uNumberOfPhyTypes, dot11PhyTypes

3) Data scraped from WLAN_BSS_ENTRY
specifically:
lRssi, uLinkQuality, usBeaconPeriod, ullTimestamp


The code I have for getting the data from WLAN_AVAILABLE_NETWORK works perfectly.

The problems I encounter is when I try getting the data from WLAN_BSS_ENTRY.

The problems seem to be multiple.
The gathering of data from WLAN_BSS_ENTRY only occasionally works for the first row of data, most of the time it produces 'garbage' info. All additional rows seem to result in 'garbage' info.

I would tend to think that the issue is a memory pointer issue not being incremented properly.

I have also noticed that the WLAN_AVAILABLE_NETWORK section that works perfectly, doesn't 'jive' with the results from WLAN_BSS_ENTRY ... ie. The SSID's aren't matched up.


Any help would be most appreciated. Probably serves me right for delving into this area of API's and such that I am not used to dealing with.

Perhaps someone such as @Jaafar Tribak or others that are wise to this approach of 'scraping' data could assist.

The following is the code I am currently trying to use to scrape the data from WLAN_AVAILABLE_NETWORK & WLAN_BSS_ENTRY:

VBA Code:
Option Explicit
'
    Private Const DOT11_SSID_MAX_LENGTH                 As Long = 32
    Private Const WLAN_MAX_PHY_TYPE_NUMBER              As Long = 8
    Private Const DOT11_RATE_SET_MAX_LENGTH             As Long = 126
'
    Private Type GUID
'        data1                                           As Long                         '   The first 4 bytes of the GUID.
'        data2                                           As Integer                      '   The next 2 bytes of the GUID.
'        data3                                           As Integer                      '   The next 2 bytes of the GUID.
'        data4(7)                                        As Byte                         '   The last 8 bytes of the GUID as an array of bytes.
        Data(15)                                        As Byte                         '   The entire 16 bytes of the GUID as an array of bytes.
    End Type
'
    Private Type WLAN_INTERFACE_INFO
        interfaceGuid                                   As GUID                         '   The globally unique identifier (GUID) of the WLAN interface.
        strInterfaceDescription(255)                    As Byte                         '   The description of the WLAN interface as an array of bytes with a maximum
'                                                                                       '           length of 255 characters.
'        IsState                                         As Long                         '   The current state of the WLAN interface.
    End Type
'
    Private Type DOT11_SSID
        uSSIDLength                                     As Long                         '   The length of the SSID (Service Set Identifier) in bytes.
        ucSSID(DOT11_SSID_MAX_LENGTH - 1)               As Byte                         '   The array of bytes that stores the actual SSID data.
    End Type
'
    Private Type DOT11_MAC_ADDRESS
        DOT11_MAC_ADDRESS(5)                            As Byte
    End Type
'
    Private Enum DOT11_BSS_TYPE
        infrastructure = 1                                                              '   An infrastructure network, which is a traditional Wi-Fi network with access
'                                                                                       '           points (APs).
        independent = 2                                                                 '   An independent or ad-hoc network, where devices communicate directly with
'                                                                                       '           each other without the use of an access point.
        Any_ = 3                                                                        '   Any BSS (Basic Service Set) type, which includes both infrastructure and
'                                                                                       '           independent networks.
    End Enum
'
    Private Enum DOT11_PHY_TYPE
        unknown = 0                                                                     '   An unknown or unspecified PHY type.
        Any_ = 0                                                                        '   Any PHY type. Note that "Any_" is used instead of "Any" due to the reserved
'                                                                                       '           keyword "Any" in VBA
        fhss = 1                                                                        '   Frequency-hopping spread spectrum (FHSS) PHY type
        dsss = 2                                                                        '   Direct-sequence spread spectrum (DSSS) PHY type.
        irbaseband = 3                                                                  '   Infrared baseband PHY type.
        ofdm = 4                                                                        '   Orthogonal frequency-division multiplexing (OFDM) PHY type.
        hrdsss = 5                                                                      '   High-rate DSSS (HRDSSS) PHY type
        erp = 6                                                                         '   Extended rate PHY (ERP) type.
        ht = 7                                                                          '   High throughput (HT) PHY type.
        vht = 8                                                                         '   Very high throughput (VHT) PHY type.
'        IHV_start   = 0x80000000
'        IHV_end     = 0xffffffff
    End Enum
'
    Private Type WLAN_RATE_SET
        uRateSetLength                                  As Long                         '   Length of the rate set in bytes.
        usRateSet(DOT11_RATE_SET_MAX_LENGTH - 1)        As Integer                      '   Array to store rate values with a maximum length of (DOT11_RATE_SET_MAX_LENGTH - 1) elements.
    End Type
'
    Private Type WLAN_AVAILABLE_NETWORK
        strProfileName(511)                             As Byte                         '   * 1: Profile name of the available network, stored as a byte array with a
'                                                                                       '           maximum length of 511 characters.
        dot11Ssid                                       As DOT11_SSID                   '   * 2: SSID of the available network, represented by the DOT11_SSID type.
        dot11BssType                                    As Long                         '   Type of Basic Service Set (BSS) of the network (e.g., infrastructure, independent).
        uNumberOfBssids                                 As Long                         '   * 7: Number of BSSIDs (MAC addresses) for the available network.
        bNetworkConnectable                             As Long                         '   Flag indicating if the network is currently connectable.
        wlanNotConnectableReason                        As Long                         '   Reason code for why the network is not connectable.
        uNumberOfPhyTypes                               As Long                         '   * 8: Number of supported PHY types for the network.
        dot11PhyTypes(WLAN_MAX_PHY_TYPE_NUMBER - 1)     As Long                         '   * 9: Array of supported PHY types (e.g., OFDM, HT) with a maximum length defined
'                                                                                       '           by WLAN_MAX_PHY_TYPE_NUMBER.
        bMorePhyTypes                                   As Long                         '   Flag indicating if there are additional PHY types not included in the array.
        wlanSignalQuality                               As Long                         '   * 3: Signal quality of the network.
        bSecurityEnabled                                As Long                         '   Flag indicating if the network has security enabled.
        dot11DefaultAuthAlgorithm                       As Long                         '   * 10: Default authentication algorithm used by the network (e.g., WPA, WPA2, etc).
        dot11DefaultCipherAlgorithm                     As Long                         '   * 11: Default cipher algorithm used by the network (e.g., TKIP, AES. etc).
        dwFlags                                         As Long                         '   * 6: Additional flags providing information about the network (e.g., hidden network).
        dwReserved                                      As Long                         '   Reserved field for future use.
    End Type
'
    Private Type WLAN_AVAILABLE_NETWORK_LIST                                            '   List of available WLAN networks
        dwNumberOfItems                                 As Long                         '   Number of items in the list
        dwIndex                                         As Long                         '   Index of the list
'        Network                                         As WLAN_AVAILABLE_NETWORK
    End Type
'
    Private Type WLAN_INTERFACE_INFO_LIST
        dwNumberOfItems                                 As Long                         '   The number of WLAN interfaces in the list.
        dwIndex                                         As Long                         '   The index of the current WLAN interface (used for enumeration).
        InterfaceInfo                                   As WLAN_INTERFACE_INFO          '   The WLAN_INTERFACE_INFO structure that holds information about the WLAN interface.
    End Type
'
    Private Type WLAN_BSS_ENTRY
        dot11Ssid                                       As DOT11_SSID                   '   SSID of the BSS
        uPhyId                                          As Long                         '   PHY ID
        dot11Bssid(0 To 5)                              As Byte                         '   BSSID (MAC address)
        dot11BssType                                    As DOT11_BSS_TYPE               '   Type of BSS (infrastructure, independent, or any)
        dot11BssPhyType                                 As DOT11_PHY_TYPE               '   PHY type of the BSS
        lRssi                                           As Long                         '   Received Signal Strength Indicator (RSSI) value
        uLinkQuality                                    As Long                         '   Link quality value
        bInRegDomain                                    As Boolean                      '   Is the BSS in a regulatory domain?
        usBeaconPeriod                                  As Integer                      '   Beacon period of the BSS
        ullTimestamp                                    As Double                       '   Timestamp
        ullHostTimestamp                                As Double                       '   Host timestamp
        usCapabilityInformation                         As Integer                      '   Capability information of the BSS
        ulChCenterFrequency                             As Long                         '   Channel center frequency of the BSS
        wlanRateSet                                     As WLAN_RATE_SET                '   WLAN rate set of the BSS
        ulIeOffset                                      As Long                         '   Information element offset
        ulIeSize                                        As Long                         '   Information element size
    End Type
'
    Private Type WLAN_BSS_LIST                                                          '   List of WLAN_BSS_ENTRY
        dwTotalSize                                     As Long                         '   Total size of the list
        dwNumberOfItems                                 As Long                         '   Number of items in the list
        wlanBssEntries(1)                               As WLAN_BSS_ENTRY               '   Fixed-size array of WLAN_BSS_ENTRY
    End Type
'
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
            Source As Any, ByVal length As Long)
'
    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 WlanCloseHandle Lib "wlanapi.dll" (ByVal hClientHandle As LongPtr, _
            Optional ByVal pReserved 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 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 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
'
    Private Declare PtrSafe Function WlanGetNetworkBssList Lib "wlanapi.dll" (ByVal hClientHandle As LongPtr, _
            ByRef pInterfaceGuid As Any, ByVal pDot11Ssid As Any, ByVal dot11BssType As Long, _
            ByVal bSecurityEnabled As Long, ByVal pReserved As Any, ByRef ppWlanBssList As LongPtr) As Long
'
    Declare PtrSafe Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As LongPtr)
                

Sub GetWiFiConnetionsDetectedV2_CombinedV1()
'
    Dim Arrayrow                As Long
    Dim EnumInterfacesList      As Long
    Dim i                       As Long
    Dim lngAvailable            As Long
    Dim lngReturn               As Long
    Dim lngStartUdtNetwork      As Long
    Dim lngStartUdtWLANbss      As Long
    Dim NetworkBssList          As Long
    Dim NumberOfItems           As Long
    Dim OpenHandleClientHandle  As Long
    Dim OpenHandleClientVersion As Long
    Dim MacAddress              As String
    Dim PhyTypesString          As String
    Dim strProfile              As String
    Dim strSSID                 As String
    Dim HeaderArray             As Variant
    Dim resultArray()           As Variant
    Dim udtNetwork              As WLAN_AVAILABLE_NETWORK
    Dim udtAvailableList        As WLAN_AVAILABLE_NETWORK_LIST
    Dim udtWLANbss              As WLAN_BSS_ENTRY
    Dim wlanBssList             As WLAN_BSS_LIST
    Dim InterfaceInfoList       As WLAN_INTERFACE_INFO_LIST
'
    Application.ScreenUpdating = False
'
    HeaderArray = Array("Profile", "SSID", "Signal Quality", "Connected", "Number of BSSids", _
            "Number of PHY Types", "PHY Types", "Default Auth Algorithm", "Default Cypher Algorithm", _
            "SSID", "PhyId", "Bssid", "BssType", "Rssi", "LinkQuality", "InRegDomain", "BeaconPeriod", "Timestamp", _
            "HostTimestamp", "CapabilityInformation", "ChCenterFrequency", "IeOffset", "IeSize", "wlanRateSet")
'
    Range("A1").CurrentRegion.ClearContents                                                 ' Clear any existing data
'
' Get a Handle
    lngReturn = WlanOpenHandle(2&, 0&, OpenHandleClientVersion, OpenHandleClientHandle)
'
    If lngReturn = 0 Then                                                                   ' If WLAN handle was successful obtained then ...
        lngReturn = WlanEnumInterfaces(ByVal OpenHandleClientHandle, 0&, EnumInterfacesList) '   Enumerate the WLAN Interfaces, (Note: this code only looks at first interface)
        CopyMemory InterfaceInfoList, ByVal EnumInterfacesList, Len(InterfaceInfoList)      '   Copy the enumerated interface information to InterfaceInfoList
'
        lngReturn = WlanScan(OpenHandleClientHandle, InterfaceInfoList.InterfaceInfo.interfaceGuid) '   Refresh the available WIFI networks list
'
        lngReturn = WlanGetAvailableNetworkList(OpenHandleClientHandle, _
                InterfaceInfoList.InterfaceInfo.interfaceGuid, 2&, 0&, lngAvailable)        '   Get network list
        CopyMemory udtAvailableList, ByVal lngAvailable, LenB(udtAvailableList)             '   Copy the network list information to udtAvailableList
        lngStartUdtNetwork = lngAvailable + 8                                               '   Set the starting memory address for the available networks data.
'
        lngReturn = WlanGetNetworkBssList(OpenHandleClientHandle, InterfaceInfoList.InterfaceInfo.interfaceGuid, _
                0&, 1, False, ByVal 0&, NetworkBssList)                                     '   Get BSS List
        CopyMemory wlanBssList, ByVal NetworkBssList, LenB(wlanBssList)                     '   Copy the BSS list information to wlanBssList
        lngStartUdtWLANbss = NetworkBssList + 8                                             '   Set the starting memory address for the BSS list data.
'
' ********************************
' * Scrape the data that we want *
' ********************************
'
        ReDim resultArray(1 To 100, 1 To UBound(HeaderArray, 1) + 1)                        '   Establish the dimensions to use for resultArray, we can correct them later
'
        Do                                                                                  '   Loop through the available WIFI networks found
            Arrayrow = Arrayrow + 1                                                         '       Increment Arrayrow
'
' Populate the Available network structure
            CopyMemory udtNetwork, ByVal lngStartUdtNetwork, Len(udtNetwork)                '       Copy the network WLAN_AVAILABLE_NETWORK data to udtNetwork
            CopyMemory udtWLANbss, ByVal lngStartUdtWLANbss, Len(udtWLANbss)                '       Copy the network WLAN_BSS_ENTRY data to udtWLANbss
'
' Save the Data from WLAN_AVAILABLE_NETWORK
            For i = 0 To UBound(udtNetwork.strProfileName)                                  '       Loop through the bytes of strProfileName
                strProfile = strProfile & Chr(udtNetwork.strProfileName(i))                 '           Save the formatted strProfileName byte to strProfile
            Next                                                                            '       Loop back
'
            strProfile = StrConv(strProfile, vbFromUnicode)                                 '       Strip the bs characters from strProfile
'
            strProfile = Left$(strProfile, InStr(strProfile, Chr(0)) - 1)                   '       Strip rest of bs characters from strProfile
'
            resultArray(Arrayrow, 1) = strProfile                                           '       Save strProfile to resultArray
            strProfile = ""                                                                 '       Clear strProfile
'
            strSSID = Replace(StrConv(udtNetwork.dot11Ssid.ucSSID, vbUnicode), Chr(0), "")  '       Format dot11Ssid.ucSSID & save it to strSSID
'
            If Len(strSSID) < 1 Then strSSID = "Unnamed"                                    '       If strSSID = "" then set strSSID = "Unnamed"
'
            resultArray(Arrayrow, 2) = strSSID                                              '       Save strSSID to resultArray
            resultArray(Arrayrow, 3) = udtNetwork.wlanSignalQuality                         '       Save wlanSignalQuality to resultArray
'
            resultArray(Arrayrow, 4) = udtNetwork.dwFlags                                   '       Save dwFlags to resultArray
            resultArray(Arrayrow, 5) = udtNetwork.uNumberOfBssids                           '       Save uNumberOfBssids to resultArray
            resultArray(Arrayrow, 6) = udtNetwork.uNumberOfPhyTypes                         '       Save uNumberOfPhyTypes to resultArray
'
            For i = 0 To UBound(udtNetwork.dot11PhyTypes)                                   '       Loop through the dot11PhyTypes
                If PhyTypesString <> "" Then                                                '           If this is NOT the first dot11PhyType then ...
                    PhyTypesString = PhyTypesString & "," & udtNetwork.dot11PhyTypes(i)     '               Append the value to PhyTypesString
                Else                                                                        '           Else ...
                    PhyTypesString = udtNetwork.dot11PhyTypes(i)                            '               Save value to PhyTypesString
                End If
            Next                                                                            '       Loop back
'
            PhyTypesString = Replace(PhyTypesString, ",0", "")                              '       Delete the excess zeros from PhyTypesString
'
            resultArray(Arrayrow, 7) = PhyTypesString                                       '       Save PhyTypesString to resultArray
            PhyTypesString = ""                                                             '       Clear PhyTypesString
'
            Select Case udtNetwork.dot11DefaultAuthAlgorithm                                '       Get dot11DefaultAuthAlgorithm and save the equated value to resultArray
                Case 1: resultArray(Arrayrow, 8) = "Open"
                Case 2: resultArray(Arrayrow, 8) = "WEP"
                Case 3: resultArray(Arrayrow, 8) = "WPA"
                Case 4: resultArray(Arrayrow, 8) = "WPA_PSK"
                Case 6: resultArray(Arrayrow, 8) = "WPA2"
                Case 7: resultArray(Arrayrow, 8) = "WPA2_PSK"
                Case 8: resultArray(Arrayrow, 8) = "WPA3"
                Case 9: resultArray(Arrayrow, 8) = "WPA3_SAE"
                Case 10: resultArray(Arrayrow, 8) = "OWE"
                Case 11: resultArray(Arrayrow, 8) = "WPA3_ENT"
            End Select
'
            resultArray(Arrayrow, 9) = udtNetwork.dot11DefaultCipherAlgorithm               '       Save dot11DefaultCipherAlgorithm to resultArray
'
' Save the Data from WLAN_BSS_ENTRY
            strSSID = Replace(StrConv(udtWLANbss.dot11Ssid.ucSSID, vbUnicode), Chr(0), "")  '       Format dot11Ssid.ucSSID & save it to strSSID
'
            If Len(strSSID) < 1 Then strSSID = "Unnamed"                                    '       If strSSID = "" then set strSSID = "Unnamed"
'
            resultArray(Arrayrow, 10) = strSSID                                             '       Save strSSID to resultArray
            resultArray(Arrayrow, 11) = udtWLANbss.uPhyId                                   '       Save uPhyId to resultArray
'
            For i = 0 To 5                                                                  '       Loop through the 6 bytes of the BSSID (MAC ADDRESS)
                MacAddress = MacAddress & Right$("0" & Hex(udtWLANbss.dot11Bssid(i)), 2) & ":"  '       Save the byte to MacAddress
            Next                                                                            '       Loop back
'
            MacAddress = Left$(MacAddress, Len(MacAddress) - 1)                             '
'
            resultArray(Arrayrow, 12) = MacAddress                                          '       Save MacAddress to resultArray
            MacAddress = ""                                                                 '       Clear MacAddress



            resultArray(Arrayrow, 13) = udtWLANbss.dot11BssType                             '       Save dot11BssType to resultArray
            resultArray(Arrayrow, 14) = udtWLANbss.lRssi                                    '       Save lRssi to resultArray
            resultArray(Arrayrow, 15) = udtWLANbss.uLinkQuality                             '       Save uLinkQuality to resultArray
            resultArray(Arrayrow, 16) = udtWLANbss.bInRegDomain                             '       Save bInRegDomain to resultArray
            resultArray(Arrayrow, 17) = udtWLANbss.usBeaconPeriod                           '       Save usBeaconPeriod to resultArray
            resultArray(Arrayrow, 18) = udtWLANbss.ullTimestamp                             '       Save ullTimestamp to resultArray
            resultArray(Arrayrow, 19) = udtWLANbss.ullHostTimestamp                         '       Save ullHostTimestamp to resultArray
            resultArray(Arrayrow, 20) = udtWLANbss.usCapabilityInformation                  '       Save usCapabilityInformation to resultArray
            resultArray(Arrayrow, 21) = udtWLANbss.ulChCenterFrequency                      '       Save ulChCenterFrequency to resultArray
            resultArray(Arrayrow, 22) = udtWLANbss.ulIeOffset                               '       Save ulIeOffset to resultArray
            resultArray(Arrayrow, 23) = udtWLANbss.ulIeSize                                 '       Save ulIeSize to resultArray
'            resultArray(Arrayrow, 24) = udtWLANbss.wlanRateSet                             ' Compile error on this line
'
            NumberOfItems = NumberOfItems + 1                                               '       Increment NumberOfItems
            lngStartUdtNetwork = lngStartUdtNetwork + Len(udtNetwork)                       '       Advance the lngStartUdtNetwork memory address
            lngStartUdtWLANbss = lngStartUdtWLANbss + Len(udtWLANbss)                       '       Advance the lngStartUdtWLANbss memory address
        Loop Until NumberOfItems = udtAvailableList.dwNumberOfItems                         '   Loop back if more WIFI networks are available
'
        Range("A1").Resize(, UBound(HeaderArray, 1) + 1) = HeaderArray                      '   Display HeaderArray to the sheet
'
        resultArray = ReDimPreserve(resultArray, Arrayrow, UBound(HeaderArray, 1) + 1)      '   Resize resultArray to actual dimensions that we ended up needing
'
        Range("A2").Resize(UBound(resultArray, 1), UBound(resultArray, 2)) = resultArray    '   Display resultArray to the sheet
'
        With Range("C2:I" & Range("I" & Rows.Count).End(xlUp).Row)                          '   Center the data in the cells in columns C:I
            .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlCenter
        End With
'
        ActiveSheet.UsedRange.EntireColumn.AutoFit                                          '   Autofit the widths of the used columns in the sheet
    End If
'
    WlanFreeMemory EnumInterfacesList
    WlanFreeMemory lngAvailable
    WlanFreeMemory NetworkBssList
    WlanCloseHandle OpenHandleClientHandle                                                  ' Release handle
'
    Application.ScreenUpdating = True                                                       ' Turn ScreenUpdating back on
End Sub


Public Function ReDimPreserve(ArrayNameToResize, NewRowUbound, NewColumnUbound)
'
' Code inspired by Control Freak
'
' Preserve Original data & LBounds & Redim both dimensions for a 2D array
'
' example usage of the function:
' ResizedArrayName = ReDimPreserve(ArrayNameToResize,NewRowSize,NewColumnSize)
' ie.
' InputArray = ReDimPreserve(InputArray,10,20)
'
' This function will keep the LBounds (Lower Bounds) of the original array.
'
    Dim NewColumn                   As Long, NewRow                      As Long
    Dim OldColumnLbound             As Long, OldRowLbound                As Long
    Dim OldColumnUbound             As Long, OldRowUbound                As Long
    Dim NewResizedArray()           As Variant
'
    ReDimPreserve = False
'
    If IsArray(ArrayNameToResize) Then                                                                      ' If the variable is an array then ...
           OldRowLbound = LBound(ArrayNameToResize, 1)                                                      '   Save the original row Lbound to OldRowLbound
        OldColumnLbound = LBound(ArrayNameToResize, 2)                                                      '   Save the original column Lbound to OldColumnLbound
'
        ReDim NewResizedArray(OldRowLbound To NewRowUbound, OldColumnLbound To NewColumnUbound)             '   Create a New 2D Array with same Lbounds as the original array
'
        OldRowUbound = UBound(ArrayNameToResize, 1)                                                         '   Save row Ubound of original array
        OldColumnUbound = UBound(ArrayNameToResize, 2)                                                      '   Save column Ubound of original array
'
        For NewRow = OldRowLbound To NewRowUbound                                                           '   Loop through rows of original array
            For NewColumn = OldColumnLbound To NewColumnUbound                                              '       Loop through columns of original array
                If OldRowUbound >= NewRow And OldColumnUbound >= NewColumn Then                             '           If more data to copy then ...
                    NewResizedArray(NewRow, NewColumn) = ArrayNameToResize(NewRow, NewColumn)               '               Append rows/columns to NewResizedArray
                End If
            Next                                                                                            '       Loop back
        Next                                                                                                '   Loop back
'
        Erase ArrayNameToResize                                                                             '   Free up the memory the Original array was taking
'
        If IsArray(NewResizedArray) Then ReDimPreserve = NewResizedArray
    End If
End Function
 
Thank you @Jaafar Tribak for responding.

I have already solved the issue on my end. After much reading, I found:
wscript-shell-specialfolders-not-behaving

A little more than half way down the page was what worked for me ...
"The entire issue is the way the input variable, vFldrName, is dimmed. If it is dimmed as a string it acts weird. Dim it as a variant and it works as expected. Since the documentations that I found simply mentions “The name of the special folder.” and does not specify the type to use and the examples provided were .SpecialFolders(“Desktop”) one would think it is a string, but apparently not."

So I dimmed TEMP_VBS_FILE As Variant and now the code works.

Now I am back to looking into how to determine Admin or not. :)
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Here is the most updated version of the code:

VBA Code:
Option Explicit
'
#If VBA7 Then                                                                               'Conditional compilation directive for VBA version 7 or higher
    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 a function to open a handle to WLAN (Wireless Local Area Network)
    Declare PtrSafe Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pdwReserved As LongPtr) As Long           ' Declare a function to close a handle to WLAN
    Declare PtrSafe Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pReserved As LongPtr, _
            ppInterfaceList As LongPtr) As Long                                             ' Declare a function to enumerate WLAN interfaces
    Declare PtrSafe Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGuid As GUID, _
            pDot11Ssid As LongPtr, pIeData As LongPtr, reserved As LongPtr) As Long         ' Declare a function to initiate a WLAN scan
    Declare PtrSafe Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGui As GUID, _
            ByVal pDot11Ssid As Long, ByVal dot11BssType As LongPtr, _
            ByVal bSecurityEnabled As LongPtr, ByVal pReserved As LongPtr, _
            ppWlanBssList As LongPtr) As Long                                               ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare PtrSafe Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As LongPtr)         ' Declare a sub to free memory allocated by WLAN functions
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As LongPtr)                     ' Declare a sub to copy memory from source to destination
    Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)             ' Declare a sub to pause execution for a specified time in milli-seconds
#Else
    Declare Function WlanOpenHandle Lib "wlanapi.dll" ( _
            ByVal dwClientVersion As Long, ByVal pdwReserved As Long, _
            ByRef pdwNegotiaitedVersion As Long, ByRef phClientHandle As Long) As Long      ' Declare a function to open a handle to WLAN (Wireless Local Area Network)
    Declare Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pdwReserved As Long) As Long                 ' Declare a function to close a handle to WLAN
    Declare Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pReserved As Long, _
            ppInterfaceList As Long) As Long                                                ' Declare a function to enumerate WLAN interfaces
    Declare Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGuid As GUID, _
            pDot11Ssid As Long, pIeData As Long, reserved As Long) As Long                  ' Declare a function to initiate a WLAN scan
    Declare Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGui As GUID, ByVal pDot11Ssid As Long, _
            ByVal dot11BssType As Long, ByVal bSecurityEnabled As Long, _
            ByVal pReserved As Long, ppWlanBssList As Long) As Long                         ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)                    ' Declare a sub to free memory allocated by WLAN functions
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As Long)                        ' Declare a sub to copy memory from source to destination
    Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)                     ' Declare a sub to pause execution for a specified time in milli-seconds
#End If
'
' Define a custom data type for storing information about a Wi-Fi SSID (Service Set Identifier)
Private Type DOT11_SSID
    uSSIDLength                 As Long                                                     ' Length of the SSID
    ucSSID(31)                  As Byte                                                     ' Array of bytes representing the SSID (up to 32 characters)
End Type
'
' Define an enumeration for different types of Wi-Fi Basic Service Set (BSS)
Private Enum DOT11_BSS_TYPE
    dot11_BSS_type_infrastructure = 1                                                       ' Infrastructure BSS (Connected to an access point)
       dot11_BSS_type_independent = 2                                                       ' Independent BSS (Ad-hoc network)
               DOT11_BSS_TYPE_ANY = 3                                                       ' Any BSS type
End Enum
'
' Define an enumeration for different types of Wi-Fi PHY (Physical) modes
Private Enum DOT11_PHY_TYPE
       dot11_phy_type_unknown = 0                                                           ' Unknown PHY type
           dot11_phy_type_any = 0                                                           ' Any PHY type
          dot11_phy_type_fhss = 1                                                           ' Frequency Hopping Spread Spectrum (FHSS)
          dot11_phy_type_dsss = 2                                                           ' Direct Sequence Spread Spectrum (DSSS)
    dot11_phy_type_irbaseband = 3                                                           ' Infrared Baseband
          dot11_phy_type_ofdm = 4                                                           ' Orthogonal Frequency Division Multiplexing (OFDM)
        dot11_phy_type_hrdsss = 5                                                           ' High-Rate DSSS (HRDSSS)
           dot11_phy_type_erp = 6                                                           ' Extended Rate PHY (ERP)
            dot11_phy_type_ht = 7                                                           ' High Throughput PHY (HT)
           dot11_phy_type_vht = 8                                                           ' Very High Throughput PHY (VHT)
     dot11_phy_type_IHV_start = &H80000000                                                  ' Start of vendor-specific PHY types
       dot11_phy_type_IHV_end = &HFFFFFFFF                                                  ' End of vendor-specific PHY types
End Enum
'
' Define a custom data type for storing FILETIME, a 64-bit value representing date and time
Private Type FILETIME
    dwLowDateTime               As Long                                                     ' Low-order bits of the file time
    dwHighDateTime              As Long                                                     ' High-order bits of the file time
End Type
'
' Define a custom data type for storing information about a Wi-Fi rate set
Private Type WLAN_RATE_SET
    uRateSetLength              As Long                                                     ' Length of the rate set
    usRateSet(125)              As Integer                                                  ' Array of integers representing supported rates
End Type
'
' Define a custom data type for storing a GUID (Globally Unique Identifier)
Private Type GUID
    data1                       As Long                                                     ' First 4 bytes of the GUID
    data2                       As Integer                                                  ' Next 2 bytes of the GUID
    data3                       As Integer                                                  ' Next 2 bytes of the GUID
    data4(7)                    As Byte                                                     ' Last 8 bytes of the GUID
End Type
'
' Define a custom data type for storing information about a Wi-Fi interface
Private Type WLAN_INTERFACE_INFO
    ifGuid                      As GUID                                                     ' GUID of the Wi-Fi interface
    InterfaceDescription(511)   As Byte                                                     ' Description of the interface (up to 512 characters)
    IsState                     As Long                                                     ' State of the interface
End Type
'
' Define a custom data type for storing a list of Wi-Fi interface information
Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberofItems             As Long                                                     ' Number of items in the list
    dwIndex                     As Long                                                     ' Index of the item
    InterfaceInfo               As WLAN_INTERFACE_INFO                                      ' Wi-Fi interface information
End Type
'
' Define a custom data type for storing a list of Wi-Fi Basic Service Set (BSS) information
Private Type WLAN_BSS_LIST
    dwTotalSize                 As Long                                                     ' Total size of the list
    dwNumberofItems             As Long                                                     ' Number of items in the list
    wlanBssEntries              As Long                                                     ' Pointer to BSS entries
End Type
'
' Define a custom data type for storing information about a Wi-Fi Basic Service Set (BSS) entry
Private Type WLAN_BSS_ENTRY
    dot11Ssid                   As DOT11_SSID                                               ' SSID of the BSS
    uPhyId                      As Long                                                     ' PHY ID of the BSS
    dot11Bssid(7)               As Byte                                                     ' BSSID (MAC address) of the BSS
    dot11BssType                As DOT11_BSS_TYPE                                           ' Type of BSS (Infrastructure, Independent, etc.)
    dot11BssPhyType             As DOT11_PHY_TYPE                                           ' PHY type of the BSS
    lRssi                       As Long                                                     ' Received Signal Strength Indicator (RSSI)
    uLinkQuality                As Long                                                     ' Link quality
    bInRegDomain                As Long                                                     ' Indicates if the BSS is in the regulatory domain
    usBeaconPeriod              As Long                                                     ' Beacon period
    ullTimestamp                As FILETIME                                                 ' Timestamp of the BSS
    ullHostTimestamp            As FILETIME                                                 ' Host timestamp
    usCapabilityInformation     As Long                                                     ' Capability information
    ulChCenterFrequency         As Long                                                     ' Center frequency of the channel
    wlanRateSet                 As WLAN_RATE_SET                                            ' Rate set supported by the BSS
    ulIeOffset                  As Long                                                     ' Information Element offset
    ulIeSize                    As Long                                                     ' Information Element size
End Type
'
Private lVersion                As Long
Public VendorDelay              As Long
Public lHandle                  As LongPtr
Private udtBSSList              As WLAN_BSS_LIST
Private udtList                 As WLAN_INTERFACE_INFO_LIST


Sub GetBSS()
'
    Dim BandNotFound                            As Boolean, DisplayVendor           As Boolean
    Dim ElevatedPrivilegesRequired              As Boolean
    Dim API_Call_Error_Value                    As Long
    Dim ArrayRow                                As Long, ResultArrayRow             As Long
    Dim IncrementalEndPosition                  As Long, IncrementalStartPosition   As Long
    Dim NumberOfBSSIDs                          As Long
    Dim SSID_Length                             As Long
    Dim BSS_Pointer_Address                     As LongPtr, BSS_Data_Start_Address  As LongPtr
    Dim WirelessInterfaceList                   As LongPtr
    Dim AvailableWirelessNetworksData           As String, NetworkAdapterName       As String
    Dim HeaderArray                             As Variant, ResultArray()           As Variant
    Dim MyPreferredOrderOfColumnHeadersArray    As Variant
    Dim WLAN_BSS_ENTRY_Array()                  As Variant
    Dim udtBSS                                  As WLAN_BSS_ENTRY
    Dim ws                                      As Worksheet
'
    Set ws = Sheets("Sheet1")                                                           ' <--- Set this to the name of the sheet to diplay the maikn results to
'
    ElevatedPrivilegesRequired = False                                                  ' <--- Set this to True if you require elevated privileges, False if you don't
    DisplayVendor = False                                                               ' <--- Set this to True if you want to see the vendor names associated with MAC Addresses
    VendorDelay = 1000                                                                  ' <--- Set this to the delay in milliseconds (1000 = 1 second) to get vendor data from site
'
'   NOTE: This code currently only processes the first wireless adapter
'
    API_Call_Error_Value = WlanOpenHandle(2&, 0&, lVersion, lHandle)                    ' Open a handle to the wireless interface
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If we didn't get handle then exit sub
'
    API_Call_Error_Value = WlanEnumInterfaces(ByVal lHandle, 0&, WirelessInterfaceList) ' Enumerate available wireless interfaces and retrieve the list
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If error occurred then exit sub
'
    Call CopyMemory(udtList, ByVal WirelessInterfaceList, LenB(udtList))                ' Copy WirelessInterfaceList data to udtList
'
    NetworkAdapterName = StrConv(udtList.InterfaceInfo.InterfaceDescription, vbUnicode)
    NetworkAdapterName = StrConv(NetworkAdapterName, vbFromUnicode)                     ' Convert the NetworkAdapterName string from Unicode to the system's default character set
'
    If InStr(NetworkAdapterName, Chr(0&)) - 1& > 0 Then
        NetworkAdapterName = Left$(NetworkAdapterName, _
                InStr(NetworkAdapterName, Chr(0&)) - 1&)                                '   Return the substring of the NetworkAdapterName string up to the null character position
    End If
'
    API_Call_Error_Value = WlanScan(lHandle, udtList.InterfaceInfo.ifGuid, ByVal 0&, _
            ByVal 0&, ByVal 0&)                                                         ' Refresh the list of available wireless networks by calling the WlanScan function
    Sleep 4500                                                                          ' Sleep for 4500 milliseconds (4.5 seconds)
'
    API_Call_Error_Value = WlanGetNetworkBssList(lHandle, udtList.InterfaceInfo.ifGuid, _
            ByVal 0&, DOT11_BSS_TYPE.DOT11_BSS_TYPE_ANY, 0, 0, BSS_Pointer_Address)     ' Get the BSS (Basic Service Set) data using the WlanGetNetworkBssList function
    CopyMemory udtBSSList, ByVal BSS_Pointer_Address, Len(udtBSSList)                   ' Copy the BSS data from the pointer address to the udtBSSList structure
'
    If API_Call_Error_Value Then                                                        ' If an error occurred obtaining the BSS data then ...
        Debug.Print "Error: "; CStr(API_Call_Error_Value)                               '   Display error to 'Immediate' window (CTRL+G in VBE window)
        MsgBox "No BSS Info Available!"                                                 '   Display pop up to user
    Else                                                                                ' Else ...
        BSS_Data_Start_Address = BSS_Pointer_Address + 8                                '   Initialize BSS_Data_Start_Address
'
        ReDim WLAN_BSS_ENTRY_Array(1 To udtBSSList.dwNumberofItems, 1 To 2)             '   Establish dimensions of WLAN_BSS_ENTRY_Array
'
        Do                                                                              '   Loop through the BSS entries and extract relevant information
            CopyMemory udtBSS, ByVal BSS_Data_Start_Address, Len(udtBSS)                '       Copy the BSS data to the udtBSS structure
'
            ArrayRow = ArrayRow + 1                                                     '       Increment ArrayRow
'
            WLAN_BSS_ENTRY_Array(ArrayRow, 1) = Right$("0" & Hex$(udtBSS.dot11Bssid(0)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(1)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(2)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(3)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(4)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(5)), 2)                       '       Convert each byte of the MAC address to a two-digit hexadecimal representation
'                                                                                       '               and concatenate them with ":" separators
            WLAN_BSS_ENTRY_Array(ArrayRow, 2) = udtBSS.lRssi                            '       Save the RSSI to WLAN_BSS_ENTRY_Array
'
            BSS_Data_Start_Address = BSS_Data_Start_Address + Len(udtBSS)               '       Increment BSS_Data_Start_Address to the next BSS entry
        Loop Until ArrayRow = udtBSSList.dwNumberofItems                                '   Loop back if there are more BSS entries
'
        WlanFreeMemory BSS_Pointer_Address                                              '   Free the memory allocated for BSS data
    End If








'
' **********************************************
' * Gather the available WIFI connections data *
' **********************************************
'
    If ElevatedPrivilegesRequired = False Then                                          ' If elevated privileges were not chosen by the user then ...
        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=False)                    '
    Else                                                                                ' Else
        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=True)                     '
    End If
'
' ******************************************
' * Strip the unneeded stuff from the data *
' ******************************************
'
    AvailableWirelessNetworksData = Replace(Replace(Replace(AvailableWirelessNetworksData, _
            " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)                                   ' Remove all spaces,Line feeds, and the like from the results of the clipboard
'
    NumberOfBSSIDs = (Len(AvailableWirelessNetworksData) - _
            Len(Replace(AvailableWirelessNetworksData, "BSSID", ""))) / Len("BSSID")    ' Count the number of BSSIDs in AvailableWirelessNetworksData
'
' ***********************************************
' * Initialize some variables that will be used *
' ***********************************************
'
    HeaderArray = Array("Network Adapter", "   SSID        ", "   Network Type        ", _
            "   Authorization Algorithm        ", "   Encryption        ", _
            "   MAC Address (BSSID)        ", "   Signal        ", "   Radio Type        ", _
            "   Band        ", "   Channel        ", "   RSSI        ", _
             "   Vendor        ")                                                       ' Establish Header names for the columns in the sheet
'
    ReDim ResultArray(1 To NumberOfBSSIDs, 1 To UBound(HeaderArray, 1) + 1)             ' Establish initial dimensions of the ResultArray
'
    ArrayRow = 0                                                                        ' Reset ArrayRow
    IncrementalEndPosition = 1                                                          ' Initialize IncrementalEndPosition value
'
' **********************************************************
' * Start saving the gathered WIFI data to our ResultArray *
' **********************************************************
'
    ResultArray(1, 1) = NetworkAdapterName                                              ' Save the name of the NetworkAdapter into ResultArray
'
    AvailableWirelessNetworksData = Mid$(AvailableWirelessNetworksData, _
            InStr(AvailableWirelessNetworksData, "SSID"))                               ' Find first SSID position
'
    Do While InStr(IncrementalEndPosition, AvailableWirelessNetworksData, "SSID") > 0
        ArrayRow = ArrayRow + 1                                                         '   Increment ArrayRow
'
' Save the SSID
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the SSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Networktype")                           '   Find the end character position of the SSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 2) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the SSID name into the ResultArray
'
        If ResultArray(ArrayRow, 2) = "" Then ResultArray(ArrayRow, 2) = "UnNamed"      '   If the saved SSID name = "" then set the SSID name to "UnNamed"
'
' Save the Networktype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Networktype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Networktype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Authentication")                        '   Find the end character position of the Networktype in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 3) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Networktype into the ResultArray
'
' Save the Authentication
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Authentication"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Authentication in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Encryption")                            '   Find the end character position of the Authentication in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 4) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Authentication into the ResultArray
'
' Save the Encryption
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Encryption"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Encryption in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "BSSID")                                 '   Find the end character position of the Encryption in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 5) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Encryption into the ResultArray
'
GetBSSIDdata:
' Save the MAC Address (BSSID)
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "BSSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the BSSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Signal")                                '   Find the end character position of the BSSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 6) = UCase(Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition))                                              '   Save the BSSID into the ResultArray
'
' Save the Signal level
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Signal"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Signal in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Radiotype")                             '   Find the end character position of the Signal in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 7) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Signal into the ResultArray
'
' Save the Radiotype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Radiotype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Radiotype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Band")                                  '   Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
        If IncrementalEndPosition = 0 Then                                              '   If 'Band' wasn't found then ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
            BandNotFound = True                                                         '       Set BandNotFound flag = True
        End If
'
        ResultArray(ArrayRow, 8) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '       Save the Radiotype into the ResultArray

'
' Save the Band if found
        If BandNotFound Then                                                            '   If 'Band' wasn't found then do nothing in this section
        Else                                                                            '   Else ...
            IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                    AvailableWirelessNetworksData, "Band"), _
                    AvailableWirelessNetworksData, ":") + 1                             '       Find the start character position of the Band in AvailableWirelessNetworksData
'
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Band in AvailableWirelessNetworksData
'
            ResultArray(ArrayRow, 9) = Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition, IncrementalEndPosition - _
                    IncrementalStartPosition)                                           '       Save the Band into the ResultArray
        End If
'
' Save the Channel & maybe calculated Band
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Channel"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Channel in AvailableWirelessNetworksData
'
        If InStr(IncrementalStartPosition, AvailableWirelessNetworksData, "H") > 0 Then '   If there is data after the Channel data that starts with "H" then ...
            IncrementalEndPosition = Application.Min(InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B"), InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "H"))                                '       Find the end character position of the Channel in AvailableWirelessNetworksData
        Else                                                                            '   Else ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B")                                 '       Find the end character position of the Channel in AvailableWirelessNetworksData
        End If
'
        ResultArray(ArrayRow, 10) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Channel into the ResultArray
'
        If BandNotFound Then                                                            '   If the BSS data did not contain data for the 'Band' then ...
            If CInt(ResultArray(ArrayRow, 10)) < 15 Then                                '       If the integer value of the channel is lass than 15 then ...
                ResultArray(ArrayRow, 9) = "2.4GHZ"                                     '           Save "2.4GHZ" to the 'Band' column of ResultArray
            Else                                                                        '       Else ...
                ResultArray(ArrayRow, 9) = "5GHZ"                                       '           Save "5GHZ" to the 'Band' column of ResultArray
            End If
'
            BandNotFound = False                                                        '       Set BandNotFound flag back to False
        End If
'
' Save the Vendor
        If DisplayVendor Then                                                           '   If the User chose to get the vendors associated with the MAC Addresses then ...
            ResultArray(ArrayRow, 12) = GetRouterBrand(ResultArray(ArrayRow, 6))        '       Save the Vendor according to the Mac Address
        End If
'
' **************************************************
' * Check for additional BSSID's for the same SSID *
' **************************************************
'
        IncrementalStartPosition = InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID")                                  '   Check for additional BSSIDs
'
        If IncrementalStartPosition <> 0 Then                                           '   If another 'SSID' is found in AvailableWirelessNetworksData then ...
            If Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition - 1, 1) = "B" Then                         '       If the found 'SSID' in AvailableWirelessNetworksData is preceded by 'B" then
                ArrayRow = ArrayRow + 1                                                 '           Increment ArrayRow
'
                ResultArray(ArrayRow, 2) = ResultArray(ArrayRow - 1, 2)                 '           Save the previous SSID into the next row of ResultArray
                ResultArray(ArrayRow, 4) = ResultArray(ArrayRow - 1, 4)                 '           Save the previous Authorization into the next row of ResultArray
                ResultArray(ArrayRow, 5) = ResultArray(ArrayRow - 1, 5)                 '           Save the previous Encryption into the next row of ResultArray
                ResultArray(ArrayRow, 3) = ResultArray(ArrayRow - 1, 3)                 '           Save the previous Networktype into the next row of ResultArray
'
                GoTo GetBSSIDdata                                                       '           Jump to GetBSSIDdata
            End If
        End If
    Loop                                                                                ' Loop back
'
' ************************************************
' * Display the final results, format data, etc. *
' ************************************************
'
    For ResultArrayRow = 1 To UBound(ResultArray, 1)                                    ' Loop through the rows of ResultArray
        For ArrayRow = 1 To UBound(WLAN_BSS_ENTRY_Array, 1)                             '   Loop through the rows of WLAN_BSS_ENTRY_Array
            If UCase(WLAN_BSS_ENTRY_Array(ArrayRow, 1)) = _
                    UCase(ResultArray(ResultArrayRow, 6)) Then                          '       If we find a matching MAC Address then ...
                ResultArray(ResultArrayRow, 11) = WLAN_BSS_ENTRY_Array(ArrayRow, 2)     '           Save the corresponding RSSI value to ResultArray
            End If
        Next                                                                            '   Loop back
    Next                                                                                ' Loop back
'
    With ws
        .Cells.Delete                                                                   '   Delete any previous results from the sheet
'
        With .Range("A1").Resize(, UBound(HeaderArray, 1) + 1)
            .Value2 = HeaderArray                                                       '       Display the HeaderArray to the sheet
            .HorizontalAlignment = xlCenter                                             '       Center the Headers horizontally in the cells
              .VerticalAlignment = xlCenter                                             '       Center the Headers vertically in the cells
                 .Font.FontStyle = "Bold"                                               '       Bold the Headers
        End With
'
        .Range("A2").Resize(UBound(ResultArray, 1), UBound(ResultArray, 2)) = ResultArray ' Display the ResultArray to the sheet
'
        If .AutoFilterMode Then .AutoFilterMode = False                                 '   If there is filtered data on the sheet then remove the filter
'
        With .Range(.Cells(1, 2), .Cells(.Rows.Count, .Cells(1, .Columns.Count).End(xlToLeft).Column))
            .Cells.Sort Key1:=.Columns(9), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to Channel Column J values lowest to highest
            .Cells.Sort Key1:=.Columns(10), Order1:=xlDescending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to RSSI Column K values highest to lowest
            .AutoFilter                                                                 '       add AutoFilter option to the sheet
        End With
'
' Now we need to rearrange the columns on the sheet to the preferred order of the columns
'
        MyPreferredOrderOfColumnHeadersArray = Array(1, 2, 6, 9, 7, 11, 10, 8, 12, 4, 5, 3)
'
        .Range("A1").Resize(.Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, _
                UBound(MyPreferredOrderOfColumnHeadersArray) + 1) = Application.Index(.Cells, _
                Evaluate("ROW(1:" & .Cells.Find("*", , xlFormulas, , xlRows, _
                xlPrevious).Row & ")"), MyPreferredOrderOfColumnHeadersArray)           '
'
        .Range("G2:G" & ArrayRow + 1).NumberFormat = "0"                                '   Format used cells in Column G as Whole numbers
        .Range("E2:E" & ArrayRow + 1).NumberFormat = "0%"                               '   Format used cells in Column E as percentages
        .Range("D2:G" & ArrayRow + 1).HorizontalAlignment = xlCenter                    '   Center the data in columns D:G horizontally in the cells
'
        .UsedRange.EntireColumn.AutoFit                                                 '   Autofit the used columns widths of the sheet
    End With
'
    MsgBox "Complete!"                                                                  '
End Sub


Function GetRouterBrand(ByVal MacAddr As String) As String
'
    Dim WebSite             As String                                                   ' Variable to hold the URL of the website for MAC address lookup
    Dim XML_HTTP            As Object                                                   ' Object variable for making HTTP requests
'
    Sleep VendorDelay                                                                   ' Delay to ensure proper processing
'
' Construct the URL for MAC address lookup using the first 8 characters of the MAC address
    WebSite = "https://api.macvendors.com/" & Left$(MacAddr, 8)                         ' <--- Set this to the website to get data from
'
    Set XML_HTTP = CreateObject("MSXML2.XMLHTTP")                                       ' Create an instance of the XMLHTTP object
'
' Send an HTTP GET request to the website to retrieve the router brand information
    With XML_HTTP
        .Open "Get", WebSite, False                                                     '   Open a GET request to the specified URL
        .send                                                                           '   Send the request
    End With
'
    If XML_HTTP.responsetext = "{""errors"":{""detail"":""Not Found""}}" Then           ' If the Vendor was not found then ...
        GetRouterBrand = "Vendor Not Found"                                             '   Return "Vendor Not Found" if vendor information is not available
    Else                                                                                ' Else ...
        GetRouterBrand = XML_HTTP.responsetext                                          '   Return the router brand information received from the website
    End If
End Function


Function Get_BSSID_Data(Optional ByVal Admin As Boolean) As String                      ' Compliments of Jaafar Tribak
'
    Dim sTempTextFile   As String
    Dim TEMP_VBS_FILE   As Variant
    Dim ObjFile         As Object
    Dim objFSO          As Object
    Dim ObjShell        As Object
'
    TEMP_VBS_FILE = Environ("TEMP") & "\BSSID.vbs"
'
    Call CreateTempVBS(TEMP_VBS_FILE)
'
    sTempTextFile = Replace(TEMP_VBS_FILE, ".vbs", ".txt")
'
    Set ObjShell = CreateObject("Shell.Application")
    ObjShell.ShellExecute "cscript", TEMP_VBS_FILE, "", IIf(Admin, "runas", ""), 0&
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
'
    With objFSO
        Set ObjFile = .CreateTextFile(sTempTextFile, True)
        Set ObjFile = .OpenTextFile(sTempTextFile, 1&)
'
        Call Sleep(1000)
'
        If Not ObjFile.AtEndOfStream Then Get_BSSID_Data = ObjFile.ReadAll
'
        ObjFile.Close
'
        .DeleteFile sTempTextFile
        .DeleteFile TEMP_VBS_FILE
    End With
End Function


Sub CreateTempVBS(ByVal FilePathName As String)                                         ' Compliments of Jaafar Tribak
    Dim sVBSCode As String
    Dim objFSO As Object, ObjFile As Object
 
    sVBSCode = "Set ObjShell = CreateObject(""Wscript.Shell"")" & vbCrLf
    sVBSCode = sVBSCode & "strCommand =""netsh wlan show network mode=bssid""" & vbCrLf
    sVBSCode = sVBSCode & "Set objExecObject = ObjShell.Exec(strCommand)" & vbCrLf
    sVBSCode = sVBSCode & "Do While Not objExecObject.StdOut.AtEndOfStream" & vbCrLf
    sVBSCode = sVBSCode & "strText = objExecObject.StdOut.ReadAll()" & vbCrLf
    sVBSCode = sVBSCode & "Loop" & vbCrLf
    sVBSCode = sVBSCode & "ResultFile =" & Chr(34) & _
               Replace(FilePathName, ".vbs", ".txt") & Chr(34) & vbCrLf
    sVBSCode = sVBSCode & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    sVBSCode = sVBSCode & "Set ObjFile = objFSO.CreateTextFile(""" & _
               Replace(FilePathName, ".vbs", ".txt") & """, True)" & vbCrLf
    sVBSCode = sVBSCode & "objFile.Close" & vbCrLf
    sVBSCode = sVBSCode & "Set objFile = objFSO.OpenTextFile(ResultFile, 2)" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Write strText" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Close"
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ObjFile = objFSO.CreateTextFile(FilePathName, True)
    ObjFile.Close
'
    Set ObjFile = objFSO.OpenTextFile(FilePathName, 2&)
    ObjFile.Write sVBSCode
    ObjFile.Close
End Sub

@Jaafar Tribak Can you try running that without elevated privileges & let me know if it works for you, or do you have to change the setting to True to allow it to work:
VBA Code:
    ElevatedPrivilegesRequired = False                                                  ' <--- Set this to True if you require elevated privileges, False if you don't
 
Upvote 0
Here is the most updated version of the code:
@Jaafar Tribak Can you try running that without elevated privileges & let me know if it works for you, or do you have to change the setting to True to allow it to work:
VBA Code:
    ElevatedPrivilegesRequired = False                                                  ' <--- Set this to True if you require elevated privileges, False if you don't
When I set ElevatedPrivilegesRequired to False , it works inconsistently. Somtimes AvailableWirelessNetworksData returns an empty string meaning that Get_BSSID_Data(Admin:=False) didn't work... but as I said, it works but inconsitently. I don't know why this is the case.

Setting ElevatedPrivilegesRequired to TRUE seems to work consistently for me.

Anyways, I don't know if this is just a unfinished preliminary draft code that you plan to complete but if not, I suggest you redefine the GetBSS SUB by making the ElevatedPrivilegesRequired, DisplayVendor and DisplayWorksheet variables as optional arguments. This will make the SUB more flexible and re-usable.

The GetBSS signature will then look like this:
VBA Code:
Sub GetBSS( _
    Optional ByVal ElevatedPrivilegesRequired As Boolean, _
    Optional ByVal DisplayVendor As Boolean, _
    Optional ByVal DisplayWorksheet As Worksheet _
)

and then you will call it for example as follows :
VBA Code:
Sub Test()
    Call GetBSS(ElevatedPrivilegesRequired:=True, DisplayVendor:=False, DisplayWorksheet:=Sheets("Sheet1"))
End Sub
Since all the args are optional, if you omit them, the first two Boolean args will default to False and the third arg will default to the activesheet.
You may consider doing the same with the VendorDelay variable.


The entire bas code will look like this :
VBA Code:
Option Explicit
'
#If VBA7 Then                                                                               'Conditional compilation directive for VBA version 7 or higher
    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 a function to open a handle to WLAN (Wireless Local Area Network)
    Declare PtrSafe Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pdwReserved As LongPtr) As Long           ' Declare a function to close a handle to WLAN
    Declare PtrSafe Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pReserved As LongPtr, _
            ppInterfaceList As LongPtr) As Long                                             ' Declare a function to enumerate WLAN interfaces
    Declare PtrSafe Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGuid As GUID, _
            pDot11Ssid As LongPtr, pIeData As LongPtr, reserved As LongPtr) As Long         ' Declare a function to initiate a WLAN scan
    Declare PtrSafe Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGui As GUID, _
            ByVal pDot11Ssid As Long, ByVal dot11BssType As LongPtr, _
            ByVal bSecurityEnabled As LongPtr, ByVal pReserved As LongPtr, _
            ppWlanBssList As LongPtr) As Long                                               ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare PtrSafe Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As LongPtr)         ' Declare a sub to free memory allocated by WLAN functions
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As LongPtr)                     ' Declare a sub to copy memory from source to destination
    Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)             ' Declare a sub to pause execution for a specified time in milli-seconds
#Else
    Declare Function WlanOpenHandle Lib "wlanapi.dll" ( _
            ByVal dwClientVersion As Long, ByVal pdwReserved As Long, _
            ByRef pdwNegotiaitedVersion As Long, ByRef phClientHandle As Long) As Long      ' Declare a function to open a handle to WLAN (Wireless Local Area Network)
    Declare Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pdwReserved As Long) As Long                 ' Declare a function to close a handle to WLAN
    Declare Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pReserved As Long, _
            ppInterfaceList As Long) As Long                                                ' Declare a function to enumerate WLAN interfaces
    Declare Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGuid As GUID, _
            pDot11Ssid As Long, pIeData As Long, reserved As Long) As Long                  ' Declare a function to initiate a WLAN scan
    Declare Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGui As GUID, ByVal pDot11Ssid As Long, _
            ByVal dot11BssType As Long, ByVal bSecurityEnabled As Long, _
            ByVal pReserved As Long, ppWlanBssList As Long) As Long                         ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)                    ' Declare a sub to free memory allocated by WLAN functions
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As Long)                        ' Declare a sub to copy memory from source to destination
    Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)                     ' Declare a sub to pause execution for a specified time in milli-seconds
#End If
'
' Define a custom data type for storing information about a Wi-Fi SSID (Service Set Identifier)
Private Type DOT11_SSID
    uSSIDLength                 As Long                                                     ' Length of the SSID
    ucSSID(31)                  As Byte                                                     ' Array of bytes representing the SSID (up to 32 characters)
End Type
'
' Define an enumeration for different types of Wi-Fi Basic Service Set (BSS)
Private Enum DOT11_BSS_TYPE
    dot11_BSS_type_infrastructure = 1                                                       ' Infrastructure BSS (Connected to an access point)
       dot11_BSS_type_independent = 2                                                       ' Independent BSS (Ad-hoc network)
               DOT11_BSS_TYPE_ANY = 3                                                       ' Any BSS type
End Enum
'
' Define an enumeration for different types of Wi-Fi PHY (Physical) modes
Private Enum DOT11_PHY_TYPE
       dot11_phy_type_unknown = 0                                                           ' Unknown PHY type
           dot11_phy_type_any = 0                                                           ' Any PHY type
          dot11_phy_type_fhss = 1                                                           ' Frequency Hopping Spread Spectrum (FHSS)
          dot11_phy_type_dsss = 2                                                           ' Direct Sequence Spread Spectrum (DSSS)
    dot11_phy_type_irbaseband = 3                                                           ' Infrared Baseband
          dot11_phy_type_ofdm = 4                                                           ' Orthogonal Frequency Division Multiplexing (OFDM)
        dot11_phy_type_hrdsss = 5                                                           ' High-Rate DSSS (HRDSSS)
           dot11_phy_type_erp = 6                                                           ' Extended Rate PHY (ERP)
            dot11_phy_type_ht = 7                                                           ' High Throughput PHY (HT)
           dot11_phy_type_vht = 8                                                           ' Very High Throughput PHY (VHT)
     dot11_phy_type_IHV_start = &H80000000                                                  ' Start of vendor-specific PHY types
       dot11_phy_type_IHV_end = &HFFFFFFFF                                                  ' End of vendor-specific PHY types
End Enum
'
' Define a custom data type for storing FILETIME, a 64-bit value representing date and time
Private Type FILETIME
    dwLowDateTime               As Long                                                     ' Low-order bits of the file time
    dwHighDateTime              As Long                                                     ' High-order bits of the file time
End Type
'
' Define a custom data type for storing information about a Wi-Fi rate set
Private Type WLAN_RATE_SET
    uRateSetLength              As Long                                                     ' Length of the rate set
    usRateSet(125)              As Integer                                                  ' Array of integers representing supported rates
End Type
'
' Define a custom data type for storing a GUID (Globally Unique Identifier)
Private Type GUID
    data1                       As Long                                                     ' First 4 bytes of the GUID
    data2                       As Integer                                                  ' Next 2 bytes of the GUID
    data3                       As Integer                                                  ' Next 2 bytes of the GUID
    data4(7)                    As Byte                                                     ' Last 8 bytes of the GUID
End Type
'
' Define a custom data type for storing information about a Wi-Fi interface
Private Type WLAN_INTERFACE_INFO
    ifGuid                      As GUID                                                     ' GUID of the Wi-Fi interface
    InterfaceDescription(511)   As Byte                                                     ' Description of the interface (up to 512 characters)
    IsState                     As Long                                                     ' State of the interface
End Type
'
' Define a custom data type for storing a list of Wi-Fi interface information
Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberofItems             As Long                                                     ' Number of items in the list
    dwIndex                     As Long                                                     ' Index of the item
    InterfaceInfo               As WLAN_INTERFACE_INFO                                      ' Wi-Fi interface information
End Type
'
' Define a custom data type for storing a list of Wi-Fi Basic Service Set (BSS) information
Private Type WLAN_BSS_LIST
    dwTotalSize                 As Long                                                     ' Total size of the list
    dwNumberofItems             As Long                                                     ' Number of items in the list
    wlanBssEntries              As Long                                                     ' Pointer to BSS entries
End Type
'
' Define a custom data type for storing information about a Wi-Fi Basic Service Set (BSS) entry
Private Type WLAN_BSS_ENTRY
    dot11Ssid                   As DOT11_SSID                                               ' SSID of the BSS
    uPhyId                      As Long                                                     ' PHY ID of the BSS
    dot11Bssid(7)               As Byte                                                     ' BSSID (MAC address) of the BSS
    dot11BssType                As DOT11_BSS_TYPE                                           ' Type of BSS (Infrastructure, Independent, etc.)
    dot11BssPhyType             As DOT11_PHY_TYPE                                           ' PHY type of the BSS
    lRssi                       As Long                                                     ' Received Signal Strength Indicator (RSSI)
    uLinkQuality                As Long                                                     ' Link quality
    bInRegDomain                As Long                                                     ' Indicates if the BSS is in the regulatory domain
    usBeaconPeriod              As Long                                                     ' Beacon period
    ullTimestamp                As FILETIME                                                 ' Timestamp of the BSS
    ullHostTimestamp            As FILETIME                                                 ' Host timestamp
    usCapabilityInformation     As Long                                                     ' Capability information
    ulChCenterFrequency         As Long                                                     ' Center frequency of the channel
    wlanRateSet                 As WLAN_RATE_SET                                            ' Rate set supported by the BSS
    ulIeOffset                  As Long                                                     ' Information Element offset
    ulIeSize                    As Long                                                     ' Information Element size
End Type
'
Private lVersion                As Long
Public VendorDelay              As Long
Public lHandle                  As LongPtr
Private udtBSSList              As WLAN_BSS_LIST
Private udtList                 As WLAN_INTERFACE_INFO_LIST


Sub Test()

    Call GetBSS(ElevatedPrivilegesRequired:=True, DisplayVendor:=False, DisplayWorksheet:=Sheets("Sheet1"))

End Sub


Sub GetBSS( _
    Optional ByVal ElevatedPrivilegesRequired As Boolean, _
    Optional ByVal DisplayVendor As Boolean, _
    Optional ByVal DisplayWorksheet As Worksheet _
)


    Dim BandNotFound                            As Boolean  ', DisplayVendor           As Boolean
'    Dim ElevatedPrivilegesRequired              As Boolean
    Dim API_Call_Error_Value                    As Long
    Dim ArrayRow                                As Long, ResultArrayRow             As Long
    Dim IncrementalEndPosition                  As Long, IncrementalStartPosition   As Long
    Dim NumberOfBSSIDs                          As Long
    Dim SSID_Length                             As Long
    Dim BSS_Pointer_Address                     As LongPtr, BSS_Data_Start_Address  As LongPtr
    Dim WirelessInterfaceList                   As LongPtr
    Dim AvailableWirelessNetworksData           As String, NetworkAdapterName       As String
    Dim HeaderArray                             As Variant, ResultArray()           As Variant
    Dim MyPreferredOrderOfColumnHeadersArray    As Variant
    Dim WLAN_BSS_ENTRY_Array()                  As Variant
    Dim udtBSS                                  As WLAN_BSS_ENTRY
'    Dim ws                                      As Worksheet '



    If DisplayWorksheet Is Nothing Then
        Set DisplayWorksheet = ActiveSheet
    End If
'    Set ws = Sheets("Sheet1")                                                          ' <--- Set this to the name of the sheet to diplay the maikn results to
'    ElevatedPrivilegesRequired = True                                                  ' <--- Set this to True if you require elevated privileges, False if you don't
'    DisplayVendor = False                                                               ' <--- Set this to True if you want to see the vendor names associated with MAC Addresses
    VendorDelay = 1000                                                                  ' <--- Set this to the delay in milliseconds (1000 = 1 second) to get vendor data from site
'
'   NOTE: This code currently only processes the first wireless adapter
'
    API_Call_Error_Value = WlanOpenHandle(2&, 0&, lVersion, lHandle)                    ' Open a handle to the wireless interface
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If we didn't get handle then exit sub
'
    API_Call_Error_Value = WlanEnumInterfaces(ByVal lHandle, 0&, WirelessInterfaceList) ' Enumerate available wireless interfaces and retrieve the list
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If error occurred then exit sub
'
    Call CopyMemory(udtList, ByVal WirelessInterfaceList, LenB(udtList))                ' Copy WirelessInterfaceList data to udtList
'
    NetworkAdapterName = StrConv(udtList.InterfaceInfo.InterfaceDescription, vbUnicode)
    NetworkAdapterName = StrConv(NetworkAdapterName, vbFromUnicode)                     ' Convert the NetworkAdapterName string from Unicode to the system's default character set
'
    If InStr(NetworkAdapterName, Chr(0&)) - 1& > 0 Then
        NetworkAdapterName = Left$(NetworkAdapterName, _
                InStr(NetworkAdapterName, Chr(0&)) - 1&)                                '   Return the substring of the NetworkAdapterName string up to the null character position
    End If
'
    API_Call_Error_Value = WlanScan(lHandle, udtList.InterfaceInfo.ifGuid, ByVal 0&, _
            ByVal 0&, ByVal 0&)                                                         ' Refresh the list of available wireless networks by calling the WlanScan function
    Sleep 4500                                                                          ' Sleep for 4500 milliseconds (4.5 seconds)
'
    API_Call_Error_Value = WlanGetNetworkBssList(lHandle, udtList.InterfaceInfo.ifGuid, _
            ByVal 0&, DOT11_BSS_TYPE.DOT11_BSS_TYPE_ANY, 0, 0, BSS_Pointer_Address)     ' Get the BSS (Basic Service Set) data using the WlanGetNetworkBssList function
    CopyMemory udtBSSList, ByVal BSS_Pointer_Address, Len(udtBSSList)                   ' Copy the BSS data from the pointer address to the udtBSSList structure
'
    If API_Call_Error_Value Then                                                        ' If an error occurred obtaining the BSS data then ...
        Debug.Print "Error: "; CStr(API_Call_Error_Value)                               '   Display error to 'Immediate' window (CTRL+G in VBE window)
        MsgBox "No BSS Info Available!"                                                 '   Display pop up to user
    Else                                                                                ' Else ...
        BSS_Data_Start_Address = BSS_Pointer_Address + 8                                '   Initialize BSS_Data_Start_Address
'
        ReDim WLAN_BSS_ENTRY_Array(1 To udtBSSList.dwNumberofItems, 1 To 2)             '   Establish dimensions of WLAN_BSS_ENTRY_Array
'
        Do                                                                              '   Loop through the BSS entries and extract relevant information
            CopyMemory udtBSS, ByVal BSS_Data_Start_Address, Len(udtBSS)                '       Copy the BSS data to the udtBSS structure
'
            ArrayRow = ArrayRow + 1                                                     '       Increment ArrayRow
'
            WLAN_BSS_ENTRY_Array(ArrayRow, 1) = Right$("0" & Hex$(udtBSS.dot11Bssid(0)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(1)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(2)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(3)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(4)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(5)), 2)                       '       Convert each byte of the MAC address to a two-digit hexadecimal representation
'                                                                                       '               and concatenate them with ":" separators
            WLAN_BSS_ENTRY_Array(ArrayRow, 2) = udtBSS.lRssi                            '       Save the RSSI to WLAN_BSS_ENTRY_Array
'
            BSS_Data_Start_Address = BSS_Data_Start_Address + Len(udtBSS)               '       Increment BSS_Data_Start_Address to the next BSS entry
        Loop Until ArrayRow = udtBSSList.dwNumberofItems                                '   Loop back if there are more BSS entries
'
        WlanFreeMemory BSS_Pointer_Address                                              '   Free the memory allocated for BSS data
    End If

'
    ' **********************************************
    ' * Gather the available WIFI connections data *
    ' **********************************************
     AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=ElevatedPrivilegesRequired)
     If Len(AvailableWirelessNetworksData) = 0 Then
        MsgBox "Failed to get Available Wireless Networks Data." & vbCrLf & vbCrLf & _
               "Elevated Privileges may be required to perform this action.", vbCritical
        Exit Sub
     End If
 
'    If ElevatedPrivilegesRequired = False Then                                          ' If elevated privileges were not chosen by the user then ...
'        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=False)                    '
'    Else                                                                                ' Else
'        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=True)                     '
'    End If
 
'
' ******************************************
' * Strip the unneeded stuff from the data *
' ******************************************
'
    AvailableWirelessNetworksData = Replace(Replace(Replace(AvailableWirelessNetworksData, _
            " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)                                   ' Remove all spaces,Line feeds, and the like from the results of the clipboard
'
    NumberOfBSSIDs = (Len(AvailableWirelessNetworksData) - _
            Len(Replace(AvailableWirelessNetworksData, "BSSID", ""))) / Len("BSSID")    ' Count the number of BSSIDs in AvailableWirelessNetworksData
'

' ***********************************************
' * Initialize some variables that will be used *
' ***********************************************
'
    HeaderArray = Array("Network Adapter", "   SSID        ", "   Network Type        ", _
            "   Authorization Algorithm        ", "   Encryption        ", _
            "   MAC Address (BSSID)        ", "   Signal        ", "   Radio Type        ", _
            "   Band        ", "   Channel        ", "   RSSI        ", _
             "   Vendor        ")                                                       ' Establish Header names for the columns in the sheet
'
    ReDim ResultArray(1 To NumberOfBSSIDs, 1 To UBound(HeaderArray, 1) + 1)             ' Establish initial dimensions of the ResultArray
'
    ArrayRow = 0                                                                        ' Reset ArrayRow
    IncrementalEndPosition = 1                                                          ' Initialize IncrementalEndPosition value
'
' **********************************************************
' * Start saving the gathered WIFI data to our ResultArray *
' **********************************************************
'
    ResultArray(1, 1) = NetworkAdapterName                                              ' Save the name of the NetworkAdapter into ResultArray
'
    AvailableWirelessNetworksData = Mid$(AvailableWirelessNetworksData, _
            InStr(AvailableWirelessNetworksData, "SSID"))                               ' Find first SSID position
'
    Do While InStr(IncrementalEndPosition, AvailableWirelessNetworksData, "SSID") > 0
        ArrayRow = ArrayRow + 1                                                         '   Increment ArrayRow
'
' Save the SSID
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the SSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Networktype")                           '   Find the end character position of the SSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 2) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the SSID name into the ResultArray
'
        If ResultArray(ArrayRow, 2) = "" Then ResultArray(ArrayRow, 2) = "UnNamed"      '   If the saved SSID name = "" then set the SSID name to "UnNamed"
'
' Save the Networktype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Networktype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Networktype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Authentication")                        '   Find the end character position of the Networktype in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 3) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Networktype into the ResultArray
'
' Save the Authentication
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Authentication"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Authentication in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Encryption")                            '   Find the end character position of the Authentication in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 4) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Authentication into the ResultArray
'
' Save the Encryption
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Encryption"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Encryption in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "BSSID")                                 '   Find the end character position of the Encryption in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 5) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Encryption into the ResultArray
'
GetBSSIDdata:
' Save the MAC Address (BSSID)
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "BSSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the BSSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Signal")                                '   Find the end character position of the BSSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 6) = UCase(Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition))                                              '   Save the BSSID into the ResultArray
'
' Save the Signal level
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Signal"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Signal in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Radiotype")                             '   Find the end character position of the Signal in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 7) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Signal into the ResultArray
'
' Save the Radiotype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Radiotype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Radiotype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Band")                                  '   Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
        If IncrementalEndPosition = 0 Then                                              '   If 'Band' wasn't found then ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
            BandNotFound = True                                                         '       Set BandNotFound flag = True
        End If
'
        ResultArray(ArrayRow, 8) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '       Save the Radiotype into the ResultArray

'
' Save the Band if found
        If BandNotFound Then                                                            '   If 'Band' wasn't found then do nothing in this section
        Else                                                                            '   Else ...
            IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                    AvailableWirelessNetworksData, "Band"), _
                    AvailableWirelessNetworksData, ":") + 1                             '       Find the start character position of the Band in AvailableWirelessNetworksData
'
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Band in AvailableWirelessNetworksData
'
            ResultArray(ArrayRow, 9) = Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition, IncrementalEndPosition - _
                    IncrementalStartPosition)                                           '       Save the Band into the ResultArray
        End If
'
' Save the Channel & maybe calculated Band
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Channel"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Channel in AvailableWirelessNetworksData
'
        If InStr(IncrementalStartPosition, AvailableWirelessNetworksData, "H") > 0 Then '   If there is data after the Channel data that starts with "H" then ...
            IncrementalEndPosition = Application.min(InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B"), InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "H"))                                '       Find the end character position of the Channel in AvailableWirelessNetworksData
        Else                                                                            '   Else ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B")                                 '       Find the end character position of the Channel in AvailableWirelessNetworksData
        End If
'
        ResultArray(ArrayRow, 10) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Channel into the ResultArray
'
        If BandNotFound Then                                                            '   If the BSS data did not contain data for the 'Band' then ...
            If CInt(ResultArray(ArrayRow, 10)) < 15 Then                                '       If the integer value of the channel is lass than 15 then ...
                ResultArray(ArrayRow, 9) = "2.4GHZ"                                     '           Save "2.4GHZ" to the 'Band' column of ResultArray
            Else                                                                        '       Else ...
                ResultArray(ArrayRow, 9) = "5GHZ"                                       '           Save "5GHZ" to the 'Band' column of ResultArray
            End If
'
            BandNotFound = False                                                        '       Set BandNotFound flag back to False
        End If
'
' Save the Vendor
        If DisplayVendor Then                                                           '   If the User chose to get the vendors associated with the MAC Addresses then ...
            ResultArray(ArrayRow, 12) = GetRouterBrand(ResultArray(ArrayRow, 6))        '       Save the Vendor according to the Mac Address
        End If
'
' **************************************************
' * Check for additional BSSID's for the same SSID *
' **************************************************
'
        IncrementalStartPosition = InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID")                                  '   Check for additional BSSIDs
'
        If IncrementalStartPosition <> 0 Then                                           '   If another 'SSID' is found in AvailableWirelessNetworksData then ...
            If Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition - 1, 1) = "B" Then                         '       If the found 'SSID' in AvailableWirelessNetworksData is preceded by 'B" then
                ArrayRow = ArrayRow + 1                                                 '           Increment ArrayRow
'
                ResultArray(ArrayRow, 2) = ResultArray(ArrayRow - 1, 2)                 '           Save the previous SSID into the next row of ResultArray
                ResultArray(ArrayRow, 4) = ResultArray(ArrayRow - 1, 4)                 '           Save the previous Authorization into the next row of ResultArray
                ResultArray(ArrayRow, 5) = ResultArray(ArrayRow - 1, 5)                 '           Save the previous Encryption into the next row of ResultArray
                ResultArray(ArrayRow, 3) = ResultArray(ArrayRow - 1, 3)                 '           Save the previous Networktype into the next row of ResultArray
'
                GoTo GetBSSIDdata                                                       '           Jump to GetBSSIDdata
            End If
        End If
    Loop                                                                                ' Loop back
'
' ************************************************
' * Display the final results, format data, etc. *
' ************************************************
'
    For ResultArrayRow = 1 To UBound(ResultArray, 1)                                    ' Loop through the rows of ResultArray
        For ArrayRow = 1 To UBound(WLAN_BSS_ENTRY_Array, 1)                             '   Loop through the rows of WLAN_BSS_ENTRY_Array
            If UCase(WLAN_BSS_ENTRY_Array(ArrayRow, 1)) = _
                    UCase(ResultArray(ResultArrayRow, 6)) Then                          '       If we find a matching MAC Address then ...
                ResultArray(ResultArrayRow, 11) = WLAN_BSS_ENTRY_Array(ArrayRow, 2)     '           Save the corresponding RSSI value to ResultArray
            End If
        Next                                                                            '   Loop back
    Next                                                                                ' Loop back
'
    With DisplayWorksheet
        .Cells.Delete                                                                   '   Delete any previous results from the sheet
'
        With .Range("A1").Resize(, UBound(HeaderArray, 1) + 1)
            .Value2 = HeaderArray                                                       '       Display the HeaderArray to the sheet
            .HorizontalAlignment = xlCenter                                             '       Center the Headers horizontally in the cells
              .VerticalAlignment = xlCenter                                             '       Center the Headers vertically in the cells
                 .Font.FontStyle = "Bold"                                               '       Bold the Headers
        End With
'
        .Range("A2").Resize(UBound(ResultArray, 1), UBound(ResultArray, 2)) = ResultArray ' Display the ResultArray to the sheet
'
        If .AutoFilterMode Then .AutoFilterMode = False                                 '   If there is filtered data on the sheet then remove the filter
'
        With .Range(.Cells(1, 2), .Cells(.Rows.Count, .Cells(1, .Columns.Count).End(xlToLeft).Column))
            .Cells.Sort Key1:=.Columns(9), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to Channel Column J values lowest to highest
            .Cells.Sort Key1:=.Columns(10), Order1:=xlDescending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to RSSI Column K values highest to lowest
            .AutoFilter                                                                 '       add AutoFilter option to the sheet
        End With
'
' Now we need to rearrange the columns on the sheet to the preferred order of the columns
'
        MyPreferredOrderOfColumnHeadersArray = Array(1, 2, 6, 9, 7, 11, 10, 8, 12, 4, 5, 3)
'
        .Range("A1").Resize(.Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, _
                UBound(MyPreferredOrderOfColumnHeadersArray) + 1) = Application.Index(.Cells, _
                Evaluate("ROW(1:" & .Cells.Find("*", , xlFormulas, , xlRows, _
                xlPrevious).Row & ")"), MyPreferredOrderOfColumnHeadersArray)           '
'
        .Range("G2:G" & ArrayRow + 1).NumberFormat = "0"                                '   Format used cells in Column G as Whole numbers
        .Range("E2:E" & ArrayRow + 1).NumberFormat = "0%"                               '   Format used cells in Column E as percentages
        .Range("D2:G" & ArrayRow + 1).HorizontalAlignment = xlCenter                    '   Center the data in columns D:G horizontally in the cells
'
        .UsedRange.EntireColumn.AutoFit                                                 '   Autofit the used columns widths of the sheet
    End With
'
    MsgBox "Complete!"                                                                  '
End Sub


Function GetRouterBrand(ByVal MacAddr As String) As String
'
    Dim WebSite             As String                                                   ' Variable to hold the URL of the website for MAC address lookup
    Dim XML_HTTP            As Object                                                   ' Object variable for making HTTP requests
'
    Sleep VendorDelay                                                                   ' Delay to ensure proper processing
'
' Construct the URL for MAC address lookup using the first 8 characters of the MAC address
    WebSite = "https://api.macvendors.com/" & Left$(MacAddr, 8)                         ' <--- Set this to the website to get data from
'
    Set XML_HTTP = CreateObject("MSXML2.XMLHTTP")                                       ' Create an instance of the XMLHTTP object
'
' Send an HTTP GET request to the website to retrieve the router brand information
    With XML_HTTP
        .Open "Get", WebSite, False                                                     '   Open a GET request to the specified URL
        .send                                                                           '   Send the request
    End With
'
    If XML_HTTP.ResponseText = "{""errors"":{""detail"":""Not Found""}}" Then           ' If the Vendor was not found then ...
        GetRouterBrand = "Vendor Not Found"                                             '   Return "Vendor Not Found" if vendor information is not available
    Else                                                                                ' Else ...
        GetRouterBrand = XML_HTTP.ResponseText                                          '   Return the router brand information received from the website
    End If
End Function


Function Get_BSSID_Data(Optional ByVal Admin As Boolean) As String                      ' Compliments of Jaafar Tribak
'
    Dim sTempTextFile   As String
    Dim TEMP_VBS_FILE   As Variant
    Dim ObjFile         As Object
    Dim objFSO          As Object
    Dim ObjShell        As Object
'
    TEMP_VBS_FILE = ThisWorkbook.Path & "\BSSID.vbs"    'Environ("TEMP") &
'
    Call CreateTempVBS(TEMP_VBS_FILE)
'
    sTempTextFile = Replace(TEMP_VBS_FILE, ".vbs", ".txt")
'
    Set ObjShell = CreateObject("Shell.Application")
    ObjShell.ShellExecute "cscript", TEMP_VBS_FILE, "", IIf(Admin, "runas", ""), 0&
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
'
    With objFSO
        Set ObjFile = .CreateTextFile(sTempTextFile, True)
        Set ObjFile = .OpenTextFile(sTempTextFile, 1&)
'
        Call Sleep(1000)
'
        If Not ObjFile.AtEndOfStream Then Get_BSSID_Data = ObjFile.ReadAll
'
        ObjFile.Close
'
'        .DeleteFile sTempTextFile
'        .DeleteFile TEMP_VBS_FILE
    End With
End Function


Sub CreateTempVBS(ByVal FilePathName As String)                                         ' Compliments of Jaafar Tribak
    Dim sVBSCode As String
    Dim objFSO As Object, ObjFile As Object
 
    sVBSCode = "Set ObjShell = CreateObject(""Wscript.Shell"")" & vbCrLf
    sVBSCode = sVBSCode & "strCommand =""netsh wlan show network mode=bssid""" & vbCrLf
    sVBSCode = sVBSCode & "Set objExecObject = ObjShell.Exec(strCommand)" & vbCrLf
    sVBSCode = sVBSCode & "Do While Not objExecObject.StdOut.AtEndOfStream" & vbCrLf
    sVBSCode = sVBSCode & "strText = objExecObject.StdOut.ReadAll()" & vbCrLf
    sVBSCode = sVBSCode & "Loop" & vbCrLf
    sVBSCode = sVBSCode & "ResultFile =" & Chr(34) & _
               Replace(FilePathName, ".vbs", ".txt") & Chr(34) & vbCrLf
    sVBSCode = sVBSCode & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    sVBSCode = sVBSCode & "Set ObjFile = objFSO.CreateTextFile(""" & _
               Replace(FilePathName, ".vbs", ".txt") & """, True)" & vbCrLf
    sVBSCode = sVBSCode & "objFile.Close" & vbCrLf
    sVBSCode = sVBSCode & "Set objFile = objFSO.OpenTextFile(ResultFile, 2)" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Write strText" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Close"
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ObjFile = objFSO.CreateTextFile(FilePathName, True)
    ObjFile.Close
'
    Set ObjFile = objFSO.OpenTextFile(FilePathName, 2&)
    ObjFile.Write sVBSCode
    ObjFile.Close
End Sub
 
Upvote 0
When you set it to run with ElevatedPrivilegesRequired = True, that produces a popup window, I tried using sendkeys to 'Tab' to the 'Yes' button but I don't think sendkeys can be used on a UAC pop up window ... Could some API calls be used so that the UAC pop up window is handled automatically?
 
Upvote 0
When you set it to run with ElevatedPrivilegesRequired = True, that produces a popup window, I tried using sendkeys to 'Tab' to the 'Yes' button but I don't think sendkeys can be used on a UAC pop up window ... Could some API calls be used so that the UAC pop up window is handled automatically?
Ah, yes. I forgot to mention that. If the UAC is set to notify the user, the Admin window will pop up .

I have the UAC level set to not notify as shown in the image below that's why I don't get the admin pop up.

Untithgfhfhgfhled.png



There is no remedy to this AFAIK as this is a security fearure and it would defeat its purpose if we could circumvent it.

The only thing I can think of is to inform the user which I already added to your code.

VBA Code:
    ' **********************************************
    ' * Gather the available WIFI connections data *
    ' **********************************************
     AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=ElevatedPrivilegesRequired)
     If Len(AvailableWirelessNetworksData) = 0 Then
        MsgBox "Failed to get Available Wireless Networks Data." & vbCrLf & vbCrLf & _
               "Elevated Privileges may be required to perform this action.", vbCritical
        Exit Sub
     End If
 
Upvote 0
One more thing : I see that you don't close the WLan handle when done which you shouldn't.

So this is the final code that worked for me!
VBA Code:
Option Explicit
'
#If VBA7 Then                                                                               'Conditional compilation directive for VBA version 7 or higher
    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 a function to open a handle to WLAN (Wireless Local Area Network)
    Declare PtrSafe Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pdwReserved As LongPtr) As Long           ' Declare a function to close a handle to WLAN
    Declare PtrSafe Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pReserved As LongPtr, _
            ppInterfaceList As LongPtr) As Long                                             ' Declare a function to enumerate WLAN interfaces
    Declare PtrSafe Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGuid As GUID, _
            pDot11Ssid As LongPtr, pIeData As LongPtr, reserved As LongPtr) As Long         ' Declare a function to initiate a WLAN scan
    Declare PtrSafe Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGui As GUID, _
            ByVal pDot11Ssid As Long, ByVal dot11BssType As LongPtr, _
            ByVal bSecurityEnabled As LongPtr, ByVal pReserved As LongPtr, _
            ppWlanBssList As LongPtr) As Long                                               ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare PtrSafe Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As LongPtr)         ' Declare a sub to free memory allocated by WLAN functions
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As LongPtr)                     ' Declare a sub to copy memory from source to destination
    Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)             ' Declare a sub to pause execution for a specified time in milli-seconds
#Else
    Declare Function WlanOpenHandle Lib "wlanapi.dll" ( _
            ByVal dwClientVersion As Long, ByVal pdwReserved As Long, _
            ByRef pdwNegotiaitedVersion As Long, ByRef phClientHandle As Long) As Long      ' Declare a function to open a handle to WLAN (Wireless Local Area Network)
    Declare Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pdwReserved As Long) As Long                 ' Declare a function to close a handle to WLAN
    Declare Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pReserved As Long, _
            ppInterfaceList As Long) As Long                                                ' Declare a function to enumerate WLAN interfaces
    Declare Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGuid As GUID, _
            pDot11Ssid As Long, pIeData As Long, reserved As Long) As Long                  ' Declare a function to initiate a WLAN scan
    Declare Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGui As GUID, ByVal pDot11Ssid As Long, _
            ByVal dot11BssType As Long, ByVal bSecurityEnabled As Long, _
            ByVal pReserved As Long, ppWlanBssList As Long) As Long                         ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)                    ' Declare a sub to free memory allocated by WLAN functions
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As Long)                        ' Declare a sub to copy memory from source to destination
    Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)                     ' Declare a sub to pause execution for a specified time in milli-seconds
#End If
'
' Define a custom data type for storing information about a Wi-Fi SSID (Service Set Identifier)
Private Type DOT11_SSID
    uSSIDLength                 As Long                                                     ' Length of the SSID
    ucSSID(31)                  As Byte                                                     ' Array of bytes representing the SSID (up to 32 characters)
End Type
'
' Define an enumeration for different types of Wi-Fi Basic Service Set (BSS)
Private Enum DOT11_BSS_TYPE
    dot11_BSS_type_infrastructure = 1                                                       ' Infrastructure BSS (Connected to an access point)
       dot11_BSS_type_independent = 2                                                       ' Independent BSS (Ad-hoc network)
               DOT11_BSS_TYPE_ANY = 3                                                       ' Any BSS type
End Enum
'
' Define an enumeration for different types of Wi-Fi PHY (Physical) modes
Private Enum DOT11_PHY_TYPE
       dot11_phy_type_unknown = 0                                                           ' Unknown PHY type
           dot11_phy_type_any = 0                                                           ' Any PHY type
          dot11_phy_type_fhss = 1                                                           ' Frequency Hopping Spread Spectrum (FHSS)
          dot11_phy_type_dsss = 2                                                           ' Direct Sequence Spread Spectrum (DSSS)
    dot11_phy_type_irbaseband = 3                                                           ' Infrared Baseband
          dot11_phy_type_ofdm = 4                                                           ' Orthogonal Frequency Division Multiplexing (OFDM)
        dot11_phy_type_hrdsss = 5                                                           ' High-Rate DSSS (HRDSSS)
           dot11_phy_type_erp = 6                                                           ' Extended Rate PHY (ERP)
            dot11_phy_type_ht = 7                                                           ' High Throughput PHY (HT)
           dot11_phy_type_vht = 8                                                           ' Very High Throughput PHY (VHT)
     dot11_phy_type_IHV_start = &H80000000                                                  ' Start of vendor-specific PHY types
       dot11_phy_type_IHV_end = &HFFFFFFFF                                                  ' End of vendor-specific PHY types
End Enum
'
' Define a custom data type for storing FILETIME, a 64-bit value representing date and time
Private Type FILETIME
    dwLowDateTime               As Long                                                     ' Low-order bits of the file time
    dwHighDateTime              As Long                                                     ' High-order bits of the file time
End Type
'
' Define a custom data type for storing information about a Wi-Fi rate set
Private Type WLAN_RATE_SET
    uRateSetLength              As Long                                                     ' Length of the rate set
    usRateSet(125)              As Integer                                                  ' Array of integers representing supported rates
End Type
'
' Define a custom data type for storing a GUID (Globally Unique Identifier)
Private Type GUID
    data1                       As Long                                                     ' First 4 bytes of the GUID
    data2                       As Integer                                                  ' Next 2 bytes of the GUID
    data3                       As Integer                                                  ' Next 2 bytes of the GUID
    data4(7)                    As Byte                                                     ' Last 8 bytes of the GUID
End Type
'
' Define a custom data type for storing information about a Wi-Fi interface
Private Type WLAN_INTERFACE_INFO
    ifGuid                      As GUID                                                     ' GUID of the Wi-Fi interface
    InterfaceDescription(511)   As Byte                                                     ' Description of the interface (up to 512 characters)
    IsState                     As Long                                                     ' State of the interface
End Type
'
' Define a custom data type for storing a list of Wi-Fi interface information
Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberofItems             As Long                                                     ' Number of items in the list
    dwIndex                     As Long                                                     ' Index of the item
    InterfaceInfo               As WLAN_INTERFACE_INFO                                      ' Wi-Fi interface information
End Type
'
' Define a custom data type for storing a list of Wi-Fi Basic Service Set (BSS) information
Private Type WLAN_BSS_LIST
    dwTotalSize                 As Long                                                     ' Total size of the list
    dwNumberofItems             As Long                                                     ' Number of items in the list
    wlanBssEntries              As Long                                                     ' Pointer to BSS entries
End Type
'
' Define a custom data type for storing information about a Wi-Fi Basic Service Set (BSS) entry
Private Type WLAN_BSS_ENTRY
    dot11Ssid                   As DOT11_SSID                                               ' SSID of the BSS
    uPhyId                      As Long                                                     ' PHY ID of the BSS
    dot11Bssid(7)               As Byte                                                     ' BSSID (MAC address) of the BSS
    dot11BssType                As DOT11_BSS_TYPE                                           ' Type of BSS (Infrastructure, Independent, etc.)
    dot11BssPhyType             As DOT11_PHY_TYPE                                           ' PHY type of the BSS
    lRssi                       As Long                                                     ' Received Signal Strength Indicator (RSSI)
    uLinkQuality                As Long                                                     ' Link quality
    bInRegDomain                As Long                                                     ' Indicates if the BSS is in the regulatory domain
    usBeaconPeriod              As Long                                                     ' Beacon period
    ullTimestamp                As FILETIME                                                 ' Timestamp of the BSS
    ullHostTimestamp            As FILETIME                                                 ' Host timestamp
    usCapabilityInformation     As Long                                                     ' Capability information
    ulChCenterFrequency         As Long                                                     ' Center frequency of the channel
    wlanRateSet                 As WLAN_RATE_SET                                            ' Rate set supported by the BSS
    ulIeOffset                  As Long                                                     ' Information Element offset
    ulIeSize                    As Long                                                     ' Information Element size
End Type
'
Private lVersion                As Long
Public VendorDelay              As Long
Public lHandle                  As LongPtr
Private udtBSSList              As WLAN_BSS_LIST
Private udtList                 As WLAN_INTERFACE_INFO_LIST


Sub Test()

    Call GetBSS(ElevatedPrivilegesRequired:=0, DisplayVendor:=False, DisplayWorksheet:=Sheets("Sheet1"))

End Sub


Sub GetBSS( _
    Optional ByVal ElevatedPrivilegesRequired As Boolean, _
    Optional ByVal DisplayVendor As Boolean, _
    Optional ByVal DisplayWorksheet As Worksheet _
)


    Dim BandNotFound                            As Boolean  ', DisplayVendor           As Boolean
'    Dim ElevatedPrivilegesRequired              As Boolean
    Dim API_Call_Error_Value                    As Long
    Dim ArrayRow                                As Long, ResultArrayRow             As Long
    Dim IncrementalEndPosition                  As Long, IncrementalStartPosition   As Long
    Dim NumberOfBSSIDs                          As Long
    Dim SSID_Length                             As Long
    Dim BSS_Pointer_Address                     As LongPtr, BSS_Data_Start_Address  As LongPtr
    Dim WirelessInterfaceList                   As LongPtr
    Dim AvailableWirelessNetworksData           As String, NetworkAdapterName       As String
    Dim HeaderArray                             As Variant, ResultArray()           As Variant
    Dim MyPreferredOrderOfColumnHeadersArray    As Variant
    Dim WLAN_BSS_ENTRY_Array()                  As Variant
    Dim udtBSS                                  As WLAN_BSS_ENTRY
'    Dim ws                                      As Worksheet '



    If DisplayWorksheet Is Nothing Then
        Set DisplayWorksheet = ActiveSheet
    End If
'    Set ws = Sheets("Sheet1")                                                          ' <--- Set this to the name of the sheet to diplay the maikn results to
'    ElevatedPrivilegesRequired = True                                                  ' <--- Set this to True if you require elevated privileges, False if you don't
'    DisplayVendor = False                                                               ' <--- Set this to True if you want to see the vendor names associated with MAC Addresses
    VendorDelay = 1000                                                                  ' <--- Set this to the delay in milliseconds (1000 = 1 second) to get vendor data from site
'
'   NOTE: This code currently only processes the first wireless adapter
'
    API_Call_Error_Value = WlanOpenHandle(2&, 0&, lVersion, lHandle)                    ' Open a handle to the wireless interface
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If we didn't get handle then exit sub
'
    API_Call_Error_Value = WlanEnumInterfaces(ByVal lHandle, 0&, WirelessInterfaceList) ' Enumerate available wireless interfaces and retrieve the list
    If API_Call_Error_Value <> 0 Then GoTo Xit                                         ' If error occurred then exit sub
'
    Call CopyMemory(udtList, ByVal WirelessInterfaceList, LenB(udtList))                ' Copy WirelessInterfaceList data to udtList
'
    NetworkAdapterName = StrConv(udtList.InterfaceInfo.InterfaceDescription, vbUnicode)
    NetworkAdapterName = StrConv(NetworkAdapterName, vbFromUnicode)                     ' Convert the NetworkAdapterName string from Unicode to the system's default character set
'
    If InStr(NetworkAdapterName, Chr(0&)) - 1& > 0 Then
        NetworkAdapterName = Left$(NetworkAdapterName, _
                InStr(NetworkAdapterName, Chr(0&)) - 1&)                                '   Return the substring of the NetworkAdapterName string up to the null character position
    End If
'
    API_Call_Error_Value = WlanScan(lHandle, udtList.InterfaceInfo.ifGuid, ByVal 0&, _
            ByVal 0&, ByVal 0&)                                                         ' Refresh the list of available wireless networks by calling the WlanScan function
    Sleep 4500                                                                          ' Sleep for 4500 milliseconds (4.5 seconds)
'
    API_Call_Error_Value = WlanGetNetworkBssList(lHandle, udtList.InterfaceInfo.ifGuid, _
            ByVal 0&, DOT11_BSS_TYPE.DOT11_BSS_TYPE_ANY, 0, 0, BSS_Pointer_Address)     ' Get the BSS (Basic Service Set) data using the WlanGetNetworkBssList function
    CopyMemory udtBSSList, ByVal BSS_Pointer_Address, Len(udtBSSList)                   ' Copy the BSS data from the pointer address to the udtBSSList structure
'
    If API_Call_Error_Value Then                                                        ' If an error occurred obtaining the BSS data then ...
        Debug.Print "Error: "; CStr(API_Call_Error_Value)                               '   Display error to 'Immediate' window (CTRL+G in VBE window)
        MsgBox "No BSS Info Available!"                                                 '   Display pop up to user
    Else                                                                                ' Else ...
        BSS_Data_Start_Address = BSS_Pointer_Address + 8                                '   Initialize BSS_Data_Start_Address
'
        ReDim WLAN_BSS_ENTRY_Array(1 To udtBSSList.dwNumberofItems, 1 To 2)             '   Establish dimensions of WLAN_BSS_ENTRY_Array
'
        Do                                                                              '   Loop through the BSS entries and extract relevant information
            CopyMemory udtBSS, ByVal BSS_Data_Start_Address, Len(udtBSS)                '       Copy the BSS data to the udtBSS structure
'
            ArrayRow = ArrayRow + 1                                                     '       Increment ArrayRow
'
            WLAN_BSS_ENTRY_Array(ArrayRow, 1) = Right$("0" & Hex$(udtBSS.dot11Bssid(0)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(1)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(2)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(3)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(4)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(5)), 2)                       '       Convert each byte of the MAC address to a two-digit hexadecimal representation
'                                                                                       '               and concatenate them with ":" separators
            WLAN_BSS_ENTRY_Array(ArrayRow, 2) = udtBSS.lRssi                            '       Save the RSSI to WLAN_BSS_ENTRY_Array
'
            BSS_Data_Start_Address = BSS_Data_Start_Address + Len(udtBSS)               '       Increment BSS_Data_Start_Address to the next BSS entry
        Loop Until ArrayRow = udtBSSList.dwNumberofItems                                '   Loop back if there are more BSS entries
'
        WlanFreeMemory BSS_Pointer_Address                                              '   Free the memory allocated for BSS data
    End If

'
    ' **********************************************
    ' * Gather the available WIFI connections data *
    ' **********************************************
     AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=ElevatedPrivilegesRequired)
     If Len(AvailableWirelessNetworksData) = 0 Then
        MsgBox "Failed to get Available Wireless Networks Data." & vbCrLf & vbCrLf & _
               "Elevated Privileges may be required to perform this action.", vbCritical
        GoTo Xit
     End If
 
'    If ElevatedPrivilegesRequired = False Then                                          ' If elevated privileges were not chosen by the user then ...
'        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=False)                    '
'    Else                                                                                ' Else
'        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=True)                     '
'    End If
    
'
' ******************************************
' * Strip the unneeded stuff from the data *
' ******************************************
'
    AvailableWirelessNetworksData = Replace(Replace(Replace(AvailableWirelessNetworksData, _
            " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)                                   ' Remove all spaces,Line feeds, and the like from the results of the clipboard
'
    NumberOfBSSIDs = (Len(AvailableWirelessNetworksData) - _
            Len(Replace(AvailableWirelessNetworksData, "BSSID", ""))) / Len("BSSID")    ' Count the number of BSSIDs in AvailableWirelessNetworksData
'

' ***********************************************
' * Initialize some variables that will be used *
' ***********************************************
'
    HeaderArray = Array("Network Adapter", "   SSID        ", "   Network Type        ", _
            "   Authorization Algorithm        ", "   Encryption        ", _
            "   MAC Address (BSSID)        ", "   Signal        ", "   Radio Type        ", _
            "   Band        ", "   Channel        ", "   RSSI        ", _
             "   Vendor        ")                                                       ' Establish Header names for the columns in the sheet
'
    ReDim ResultArray(1 To NumberOfBSSIDs, 1 To UBound(HeaderArray, 1) + 1)             ' Establish initial dimensions of the ResultArray
'
    ArrayRow = 0                                                                        ' Reset ArrayRow
    IncrementalEndPosition = 1                                                          ' Initialize IncrementalEndPosition value
'
' **********************************************************
' * Start saving the gathered WIFI data to our ResultArray *
' **********************************************************
'
    ResultArray(1, 1) = NetworkAdapterName                                              ' Save the name of the NetworkAdapter into ResultArray
'
    AvailableWirelessNetworksData = Mid$(AvailableWirelessNetworksData, _
            InStr(AvailableWirelessNetworksData, "SSID"))                               ' Find first SSID position
'
    Do While InStr(IncrementalEndPosition, AvailableWirelessNetworksData, "SSID") > 0
        ArrayRow = ArrayRow + 1                                                         '   Increment ArrayRow
'
' Save the SSID
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the SSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Networktype")                           '   Find the end character position of the SSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 2) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the SSID name into the ResultArray
'
        If ResultArray(ArrayRow, 2) = "" Then ResultArray(ArrayRow, 2) = "UnNamed"      '   If the saved SSID name = "" then set the SSID name to "UnNamed"
'
' Save the Networktype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Networktype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Networktype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Authentication")                        '   Find the end character position of the Networktype in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 3) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Networktype into the ResultArray
'
' Save the Authentication
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Authentication"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Authentication in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Encryption")                            '   Find the end character position of the Authentication in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 4) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Authentication into the ResultArray
'
' Save the Encryption
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Encryption"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Encryption in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "BSSID")                                 '   Find the end character position of the Encryption in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 5) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Encryption into the ResultArray
'
GetBSSIDdata:
' Save the MAC Address (BSSID)
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "BSSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the BSSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Signal")                                '   Find the end character position of the BSSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 6) = UCase(Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition))                                              '   Save the BSSID into the ResultArray
'
' Save the Signal level
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Signal"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Signal in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Radiotype")                             '   Find the end character position of the Signal in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 7) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Signal into the ResultArray
'
' Save the Radiotype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Radiotype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Radiotype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Band")                                  '   Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
        If IncrementalEndPosition = 0 Then                                              '   If 'Band' wasn't found then ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
            BandNotFound = True                                                         '       Set BandNotFound flag = True
        End If
'
        ResultArray(ArrayRow, 8) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '       Save the Radiotype into the ResultArray

'
' Save the Band if found
        If BandNotFound Then                                                            '   If 'Band' wasn't found then do nothing in this section
        Else                                                                            '   Else ...
            IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                    AvailableWirelessNetworksData, "Band"), _
                    AvailableWirelessNetworksData, ":") + 1                             '       Find the start character position of the Band in AvailableWirelessNetworksData
'
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Band in AvailableWirelessNetworksData
'
            ResultArray(ArrayRow, 9) = Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition, IncrementalEndPosition - _
                    IncrementalStartPosition)                                           '       Save the Band into the ResultArray
        End If
'
' Save the Channel & maybe calculated Band
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Channel"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Channel in AvailableWirelessNetworksData
'
        If InStr(IncrementalStartPosition, AvailableWirelessNetworksData, "H") > 0 Then '   If there is data after the Channel data that starts with "H" then ...
            IncrementalEndPosition = Application.min(InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B"), InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "H"))                                '       Find the end character position of the Channel in AvailableWirelessNetworksData
        Else                                                                            '   Else ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B")                                 '       Find the end character position of the Channel in AvailableWirelessNetworksData
        End If
'
        ResultArray(ArrayRow, 10) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Channel into the ResultArray
'
        If BandNotFound Then                                                            '   If the BSS data did not contain data for the 'Band' then ...
            If CInt(ResultArray(ArrayRow, 10)) < 15 Then                                '       If the integer value of the channel is lass than 15 then ...
                ResultArray(ArrayRow, 9) = "2.4GHZ"                                     '           Save "2.4GHZ" to the 'Band' column of ResultArray
            Else                                                                        '       Else ...
                ResultArray(ArrayRow, 9) = "5GHZ"                                       '           Save "5GHZ" to the 'Band' column of ResultArray
            End If
'
            BandNotFound = False                                                        '       Set BandNotFound flag back to False
        End If
'
' Save the Vendor
        If DisplayVendor Then                                                           '   If the User chose to get the vendors associated with the MAC Addresses then ...
            ResultArray(ArrayRow, 12) = GetRouterBrand(ResultArray(ArrayRow, 6))        '       Save the Vendor according to the Mac Address
        End If
'
' **************************************************
' * Check for additional BSSID's for the same SSID *
' **************************************************
'
        IncrementalStartPosition = InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID")                                  '   Check for additional BSSIDs
'
        If IncrementalStartPosition <> 0 Then                                           '   If another 'SSID' is found in AvailableWirelessNetworksData then ...
            If Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition - 1, 1) = "B" Then                         '       If the found 'SSID' in AvailableWirelessNetworksData is preceded by 'B" then
                ArrayRow = ArrayRow + 1                                                 '           Increment ArrayRow
'
                ResultArray(ArrayRow, 2) = ResultArray(ArrayRow - 1, 2)                 '           Save the previous SSID into the next row of ResultArray
                ResultArray(ArrayRow, 4) = ResultArray(ArrayRow - 1, 4)                 '           Save the previous Authorization into the next row of ResultArray
                ResultArray(ArrayRow, 5) = ResultArray(ArrayRow - 1, 5)                 '           Save the previous Encryption into the next row of ResultArray
                ResultArray(ArrayRow, 3) = ResultArray(ArrayRow - 1, 3)                 '           Save the previous Networktype into the next row of ResultArray
'
                GoTo GetBSSIDdata                                                       '           Jump to GetBSSIDdata
            End If
        End If
    Loop                                                                                ' Loop back
'
' ************************************************
' * Display the final results, format data, etc. *
' ************************************************
'
    For ResultArrayRow = 1 To UBound(ResultArray, 1)                                    ' Loop through the rows of ResultArray
        For ArrayRow = 1 To UBound(WLAN_BSS_ENTRY_Array, 1)                             '   Loop through the rows of WLAN_BSS_ENTRY_Array
            If UCase(WLAN_BSS_ENTRY_Array(ArrayRow, 1)) = _
                    UCase(ResultArray(ResultArrayRow, 6)) Then                          '       If we find a matching MAC Address then ...
                ResultArray(ResultArrayRow, 11) = WLAN_BSS_ENTRY_Array(ArrayRow, 2)     '           Save the corresponding RSSI value to ResultArray
            End If
        Next                                                                            '   Loop back
    Next                                                                                ' Loop back
'
    With DisplayWorksheet
        .Cells.Delete                                                                   '   Delete any previous results from the sheet
'
        With .Range("A1").Resize(, UBound(HeaderArray, 1) + 1)
            .Value2 = HeaderArray                                                       '       Display the HeaderArray to the sheet
            .HorizontalAlignment = xlCenter                                             '       Center the Headers horizontally in the cells
              .VerticalAlignment = xlCenter                                             '       Center the Headers vertically in the cells
                 .Font.FontStyle = "Bold"                                               '       Bold the Headers
        End With
'
        .Range("A2").Resize(UBound(ResultArray, 1), UBound(ResultArray, 2)) = ResultArray ' Display the ResultArray to the sheet
'
        If .AutoFilterMode Then .AutoFilterMode = False                                 '   If there is filtered data on the sheet then remove the filter
'
        With .Range(.Cells(1, 2), .Cells(.Rows.Count, .Cells(1, .Columns.Count).End(xlToLeft).Column))
            .Cells.Sort Key1:=.Columns(9), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to Channel Column J values lowest to highest
            .Cells.Sort Key1:=.Columns(10), Order1:=xlDescending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to RSSI Column K values highest to lowest
            .AutoFilter                                                                 '       add AutoFilter option to the sheet
        End With
'
' Now we need to rearrange the columns on the sheet to the preferred order of the columns
'
        MyPreferredOrderOfColumnHeadersArray = Array(1, 2, 6, 9, 7, 11, 10, 8, 12, 4, 5, 3)
'
        .Range("A1").Resize(.Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, _
                UBound(MyPreferredOrderOfColumnHeadersArray) + 1) = Application.Index(.Cells, _
                Evaluate("ROW(1:" & .Cells.Find("*", , xlFormulas, , xlRows, _
                xlPrevious).Row & ")"), MyPreferredOrderOfColumnHeadersArray)           '
'
        .Range("G2:G" & ArrayRow + 1).NumberFormat = "0"                                '   Format used cells in Column G as Whole numbers
        .Range("E2:E" & ArrayRow + 1).NumberFormat = "0%"                               '   Format used cells in Column E as percentages
        .Range("D2:G" & ArrayRow + 1).HorizontalAlignment = xlCenter                    '   Center the data in columns D:G horizontally in the cells
'
        .UsedRange.EntireColumn.AutoFit                                                 '   Autofit the used columns widths of the sheet
    End With
'
    MsgBox "Complete!"
    
Xit:
    WlanCloseHandle lHandle, ByVal 0 '
End Sub


Function GetRouterBrand(ByVal MacAddr As String) As String
'
    Dim WebSite             As String                                                   ' Variable to hold the URL of the website for MAC address lookup
    Dim XML_HTTP            As Object                                                   ' Object variable for making HTTP requests
'
    Sleep VendorDelay                                                                   ' Delay to ensure proper processing
'
' Construct the URL for MAC address lookup using the first 8 characters of the MAC address
    WebSite = "https://api.macvendors.com/" & Left$(MacAddr, 8)                         ' <--- Set this to the website to get data from
'
    Set XML_HTTP = CreateObject("MSXML2.XMLHTTP")                                       ' Create an instance of the XMLHTTP object
'
' Send an HTTP GET request to the website to retrieve the router brand information
    With XML_HTTP
        .Open "Get", WebSite, False                                                     '   Open a GET request to the specified URL
        .send                                                                           '   Send the request
    End With
'
    If XML_HTTP.ResponseText = "{""errors"":{""detail"":""Not Found""}}" Then           ' If the Vendor was not found then ...
        GetRouterBrand = "Vendor Not Found"                                             '   Return "Vendor Not Found" if vendor information is not available
    Else                                                                                ' Else ...
        GetRouterBrand = XML_HTTP.ResponseText                                          '   Return the router brand information received from the website
    End If
End Function


Function Get_BSSID_Data(Optional ByVal Admin As Boolean) As String                      ' Compliments of Jaafar Tribak
'
    Dim sTempTextFile   As String
    Dim TEMP_VBS_FILE   As Variant
    Dim ObjFile         As Object
    Dim objFSO          As Object
    Dim ObjShell        As Object
'
    TEMP_VBS_FILE = Environ("TEMP") & "\BSSID.vbs"   ' ThisWorkbook.Path & "\BSSID.vbs"
'
    Call CreateTempVBS(TEMP_VBS_FILE)
'
    sTempTextFile = Replace(TEMP_VBS_FILE, ".vbs", ".txt")
'
    Set ObjShell = CreateObject("Shell.Application")
    ObjShell.ShellExecute "cscript", TEMP_VBS_FILE, "", IIf(Admin, "runas", ""), 0&
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
'
    With objFSO
        Set ObjFile = .CreateTextFile(sTempTextFile, True)
        Set ObjFile = .OpenTextFile(sTempTextFile, 1&)
'
        Call Sleep(1000)
'
        If Not ObjFile.AtEndOfStream Then Get_BSSID_Data = ObjFile.ReadAll
'
        ObjFile.Close
'
'        .DeleteFile sTempTextFile
'        .DeleteFile TEMP_VBS_FILE
    End With
End Function


Sub CreateTempVBS(ByVal FilePathName As String)                                         ' Compliments of Jaafar Tribak
    Dim sVBSCode As String
    Dim objFSO As Object, ObjFile As Object
 
    sVBSCode = "Set ObjShell = CreateObject(""Wscript.Shell"")" & vbCrLf
    sVBSCode = sVBSCode & "strCommand =""netsh wlan show network mode=bssid""" & vbCrLf
    sVBSCode = sVBSCode & "Set objExecObject = ObjShell.Exec(strCommand)" & vbCrLf
    sVBSCode = sVBSCode & "Do While Not objExecObject.StdOut.AtEndOfStream" & vbCrLf
    sVBSCode = sVBSCode & "strText = objExecObject.StdOut.ReadAll()" & vbCrLf
    sVBSCode = sVBSCode & "Loop" & vbCrLf
    sVBSCode = sVBSCode & "ResultFile =" & Chr(34) & _
               Replace(FilePathName, ".vbs", ".txt") & Chr(34) & vbCrLf
    sVBSCode = sVBSCode & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    sVBSCode = sVBSCode & "Set ObjFile = objFSO.CreateTextFile(""" & _
               Replace(FilePathName, ".vbs", ".txt") & """, True)" & vbCrLf
    sVBSCode = sVBSCode & "objFile.Close" & vbCrLf
    sVBSCode = sVBSCode & "Set objFile = objFSO.OpenTextFile(ResultFile, 2)" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Write strText" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Close"
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ObjFile = objFSO.CreateTextFile(FilePathName, True)
    ObjFile.Close
'
    Set ObjFile = objFSO.OpenTextFile(FilePathName, 2&)
    ObjFile.Write sVBSCode
    ObjFile.Close
End Sub
 
Upvote 0
When I set ElevatedPrivilegesRequired to False , it works inconsistently. Somtimes AvailableWirelessNetworksData returns an empty string meaning that Get_BSSID_Data(Admin:=False) didn't work... but as I said, it works but inconsitently. I don't know why this is the case.

So, if you are saying that it occasionally works when ElevatedPrivilegesRequired is set to 'False', Please try the following:

VBA Code:
Option Explicit
'
#If VBA7 Then                                                                               'Conditional compilation directive for VBA version 7 or higher
    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 a function to open a handle to WLAN (Wireless Local Area Network)
    Declare PtrSafe Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pdwReserved As LongPtr) As Long           ' Declare a function to close a handle to WLAN
    Declare PtrSafe Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pReserved As LongPtr, _
            ppInterfaceList As LongPtr) As Long                                             ' Declare a function to enumerate WLAN interfaces
    Declare PtrSafe Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGuid As GUID, _
            pDot11Ssid As LongPtr, pIeData As LongPtr, reserved As LongPtr) As Long         ' Declare a function to initiate a WLAN scan
    Declare PtrSafe Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGui As GUID, _
            ByVal pDot11Ssid As Long, ByVal dot11BssType As LongPtr, _
            ByVal bSecurityEnabled As LongPtr, ByVal pReserved As LongPtr, _
            ppWlanBssList As LongPtr) As Long                                               ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare PtrSafe Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As LongPtr)         ' Declare a sub to free memory allocated by WLAN functions
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As LongPtr)                     ' Declare a sub to copy memory from source to destination
    Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)             ' Declare a sub to pause execution for a specified time in milli-seconds
#Else
    Declare Function WlanOpenHandle Lib "wlanapi.dll" ( _
            ByVal dwClientVersion As Long, ByVal pdwReserved As Long, _
            ByRef pdwNegotiaitedVersion As Long, ByRef phClientHandle As Long) As Long      ' Declare a function to open a handle to WLAN (Wireless Local Area Network)
    Declare Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pdwReserved As Long) As Long                 ' Declare a function to close a handle to WLAN
    Declare Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pReserved As Long, _
            ppInterfaceList As Long) As Long                                                ' Declare a function to enumerate WLAN interfaces
    Declare Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGuid As GUID, _
            pDot11Ssid As Long, pIeData As Long, reserved As Long) As Long                  ' Declare a function to initiate a WLAN scan
    Declare Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGui As GUID, ByVal pDot11Ssid As Long, _
            ByVal dot11BssType As Long, ByVal bSecurityEnabled As Long, _
            ByVal pReserved As Long, ppWlanBssList As Long) As Long                         ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)                    ' Declare a sub to free memory allocated by WLAN functions
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As Long)                        ' Declare a sub to copy memory from source to destination
    Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)                     ' Declare a sub to pause execution for a specified time in milli-seconds
#End If
'
' Define a custom data type for storing information about a Wi-Fi SSID (Service Set Identifier)
Private Type DOT11_SSID
    uSSIDLength                 As Long                                                     ' Length of the SSID
    ucSSID(31)                  As Byte                                                     ' Array of bytes representing the SSID (up to 32 characters)
End Type
'
' Define an enumeration for different types of Wi-Fi Basic Service Set (BSS)
Private Enum DOT11_BSS_TYPE
    dot11_BSS_type_infrastructure = 1                                                       ' Infrastructure BSS (Connected to an access point)
       dot11_BSS_type_independent = 2                                                       ' Independent BSS (Ad-hoc network)
               DOT11_BSS_TYPE_ANY = 3                                                       ' Any BSS type
End Enum
'
' Define an enumeration for different types of Wi-Fi PHY (Physical) modes
Private Enum DOT11_PHY_TYPE
       dot11_phy_type_unknown = 0                                                           ' Unknown PHY type
           dot11_phy_type_any = 0                                                           ' Any PHY type
          dot11_phy_type_fhss = 1                                                           ' Frequency Hopping Spread Spectrum (FHSS)
          dot11_phy_type_dsss = 2                                                           ' Direct Sequence Spread Spectrum (DSSS)
    dot11_phy_type_irbaseband = 3                                                           ' Infrared Baseband
          dot11_phy_type_ofdm = 4                                                           ' Orthogonal Frequency Division Multiplexing (OFDM)
        dot11_phy_type_hrdsss = 5                                                           ' High-Rate DSSS (HRDSSS)
           dot11_phy_type_erp = 6                                                           ' Extended Rate PHY (ERP)
            dot11_phy_type_ht = 7                                                           ' High Throughput PHY (HT)
           dot11_phy_type_vht = 8                                                           ' Very High Throughput PHY (VHT)
     dot11_phy_type_IHV_start = &H80000000                                                  ' Start of vendor-specific PHY types
       dot11_phy_type_IHV_end = &HFFFFFFFF                                                  ' End of vendor-specific PHY types
End Enum
'
' Define a custom data type for storing FILETIME, a 64-bit value representing date and time
Private Type FILETIME
    dwLowDateTime               As Long                                                     ' Low-order bits of the file time
    dwHighDateTime              As Long                                                     ' High-order bits of the file time
End Type
'
' Define a custom data type for storing information about a Wi-Fi rate set
Private Type WLAN_RATE_SET
    uRateSetLength              As Long                                                     ' Length of the rate set
    usRateSet(125)              As Integer                                                  ' Array of integers representing supported rates
End Type
'
' Define a custom data type for storing a GUID (Globally Unique Identifier)
Private Type GUID
    data1                       As Long                                                     ' First 4 bytes of the GUID
    data2                       As Integer                                                  ' Next 2 bytes of the GUID
    data3                       As Integer                                                  ' Next 2 bytes of the GUID
    data4(7)                    As Byte                                                     ' Last 8 bytes of the GUID
End Type
'
' Define a custom data type for storing information about a Wi-Fi interface
Private Type WLAN_INTERFACE_INFO
    ifGuid                      As GUID                                                     ' GUID of the Wi-Fi interface
    InterfaceDescription(511)   As Byte                                                     ' Description of the interface (up to 512 characters)
    IsState                     As Long                                                     ' State of the interface
End Type
'
' Define a custom data type for storing a list of Wi-Fi interface information
Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberofItems             As Long                                                     ' Number of items in the list
    dwIndex                     As Long                                                     ' Index of the item
    InterfaceInfo               As WLAN_INTERFACE_INFO                                      ' Wi-Fi interface information
End Type
'
' Define a custom data type for storing a list of Wi-Fi Basic Service Set (BSS) information
Private Type WLAN_BSS_LIST
    dwTotalSize                 As Long                                                     ' Total size of the list
    dwNumberofItems             As Long                                                     ' Number of items in the list
    wlanBssEntries              As Long                                                     ' Pointer to BSS entries
End Type
'
' Define a custom data type for storing information about a Wi-Fi Basic Service Set (BSS) entry
Private Type WLAN_BSS_ENTRY
    dot11Ssid                   As DOT11_SSID                                               ' SSID of the BSS
    uPhyId                      As Long                                                     ' PHY ID of the BSS
    dot11Bssid(7)               As Byte                                                     ' BSSID (MAC address) of the BSS
    dot11BssType                As DOT11_BSS_TYPE                                           ' Type of BSS (Infrastructure, Independent, etc.)
    dot11BssPhyType             As DOT11_PHY_TYPE                                           ' PHY type of the BSS
    lRssi                       As Long                                                     ' Received Signal Strength Indicator (RSSI)
    uLinkQuality                As Long                                                     ' Link quality
    bInRegDomain                As Long                                                     ' Indicates if the BSS is in the regulatory domain
    usBeaconPeriod              As Long                                                     ' Beacon period
    ullTimestamp                As FILETIME                                                 ' Timestamp of the BSS
    ullHostTimestamp            As FILETIME                                                 ' Host timestamp
    usCapabilityInformation     As Long                                                     ' Capability information
    ulChCenterFrequency         As Long                                                     ' Center frequency of the channel
    wlanRateSet                 As WLAN_RATE_SET                                            ' Rate set supported by the BSS
    ulIeOffset                  As Long                                                     ' Information Element offset
    ulIeSize                    As Long                                                     ' Information Element size
End Type
'
Private lVersion                As Long
Public lHandle                  As LongPtr
Private udtBSSList              As WLAN_BSS_LIST
Private udtList                 As WLAN_INTERFACE_INFO_LIST


Sub GetInfoAboutWifiNetworksNearMe()
'
    Dim DisplayWorksheet    As Worksheet
'
    Set DisplayWorksheet = Sheets("Sheet1")                                                 ' Set the DisplayWorksheet to the sheet that you want to display final results to
'
    Call GetBSS(DisplayWorksheet, DisplayVendor:=False)                                     ' <--- Set the DisplayVendor to False if you don't want to convert each
'                                                                                           '       MAC Address to a Vendor, Set to True if you do ... a True setting will
'                                                                                           '       add to the amount of time that the script takes to complete
'                                                                                           '       directly proportianal to the amount of MAC Addresses that have been found
End Sub


Sub GetBSS(Optional ByVal ws As Worksheet, Optional ByVal DisplayVendor As Boolean = False)
'
    Dim BandNotFound                            As Boolean
    Dim API_Call_Error_Value                    As Long
    Dim ArrayRow                                As Long, ResultArrayRow             As Long
    Dim IncrementalEndPosition                  As Long, IncrementalStartPosition   As Long
    Dim NonElevatedTry                          As Long
    Dim NumberOfBSSIDs                          As Long
    Dim SSID_Length                             As Long
    Dim VendorDelay                             As Long
    Dim BSS_Pointer_Address                     As LongPtr, BSS_Data_Start_Address  As LongPtr
    Dim WirelessInterfaceList                   As LongPtr
    Dim AvailableWirelessNetworksData           As String, NetworkAdapterName       As String
    Dim HeaderArray                             As Variant, ResultArray()           As Variant
    Dim MyPreferredOrderOfColumnHeadersArray    As Variant
    Dim WLAN_BSS_ENTRY_Array()                  As Variant
    Dim udtBSS                                  As WLAN_BSS_ENTRY
'
    VendorDelay = 1000                                                                  ' <--- Set this to the delay in milliseconds (1000 = 1 second) to get vendor data from site
'
'   NOTE: This code currently only processes the first wireless adapter
'
    API_Call_Error_Value = WlanOpenHandle(2&, 0&, lVersion, lHandle)                    ' Open a handle to the wireless interface
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If we didn't get handle then exit sub
'
    API_Call_Error_Value = WlanEnumInterfaces(ByVal lHandle, 0&, WirelessInterfaceList) ' Enumerate available wireless interfaces and retrieve the list
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If error occurred then exit sub
'
    Call CopyMemory(udtList, ByVal WirelessInterfaceList, LenB(udtList))                ' Copy WirelessInterfaceList data to udtList
'
    NetworkAdapterName = StrConv(udtList.InterfaceInfo.InterfaceDescription, vbUnicode)
    NetworkAdapterName = StrConv(NetworkAdapterName, vbFromUnicode)                     ' Convert the NetworkAdapterName string from Unicode to the system's default character set
'
    If InStr(NetworkAdapterName, Chr(0&)) - 1& > 0 Then
        NetworkAdapterName = Left$(NetworkAdapterName, _
                InStr(NetworkAdapterName, Chr(0&)) - 1&)                                '   Return the substring of the NetworkAdapterName string up to the null character position
    End If
'
    API_Call_Error_Value = WlanScan(lHandle, udtList.InterfaceInfo.ifGuid, ByVal 0&, _
            ByVal 0&, ByVal 0&)                                                         ' Refresh the list of available wireless networks by calling the WlanScan function
    Sleep 4500                                                                          ' Sleep for 4500 milliseconds (4.5 seconds)
'
    API_Call_Error_Value = WlanGetNetworkBssList(lHandle, udtList.InterfaceInfo.ifGuid, _
            ByVal 0&, DOT11_BSS_TYPE.DOT11_BSS_TYPE_ANY, 0, 0, BSS_Pointer_Address)     ' Get the BSS (Basic Service Set) data using the WlanGetNetworkBssList function
    CopyMemory udtBSSList, ByVal BSS_Pointer_Address, Len(udtBSSList)                   ' Copy the BSS data from the pointer address to the udtBSSList structure
'
    If API_Call_Error_Value Then                                                        ' If an error occurred obtaining the BSS data then ...
        Debug.Print "Error: "; CStr(API_Call_Error_Value)                               '   Display error to 'Immediate' window (CTRL+G in VBE window)
        MsgBox "No BSS Info Available!"                                                 '   Display pop up to user
    Else                                                                                ' Else ...
        BSS_Data_Start_Address = BSS_Pointer_Address + 8                                '   Initialize BSS_Data_Start_Address
'
        ReDim WLAN_BSS_ENTRY_Array(1 To udtBSSList.dwNumberofItems, 1 To 2)             '   Establish dimensions of WLAN_BSS_ENTRY_Array
'
        Do                                                                              '   Loop through the BSS entries and extract relevant information
            CopyMemory udtBSS, ByVal BSS_Data_Start_Address, Len(udtBSS)                '       Copy the BSS data to the udtBSS structure
'
            ArrayRow = ArrayRow + 1                                                     '       Increment ArrayRow
'
            WLAN_BSS_ENTRY_Array(ArrayRow, 1) = Right$("0" & Hex$(udtBSS.dot11Bssid(0)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(1)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(2)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(3)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(4)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(5)), 2)                       '       Convert each byte of the MAC address to a two-digit hexadecimal representation
'                                                                                       '               and concatenate them with ":" separators
            WLAN_BSS_ENTRY_Array(ArrayRow, 2) = udtBSS.lRssi                            '       Save the RSSI to WLAN_BSS_ENTRY_Array
'
            BSS_Data_Start_Address = BSS_Data_Start_Address + Len(udtBSS)               '       Increment BSS_Data_Start_Address to the next BSS entry
        Loop Until ArrayRow = udtBSSList.dwNumberofItems                                '   Loop back if there are more BSS entries
'
        WlanFreeMemory BSS_Pointer_Address                                              '   Free the memory allocated for BSS data
    End If








'
' **********************************************
' * Gather the available WIFI connections data *
' **********************************************
'
    For NonElevatedTry = 1 To 3                                                     '   Loop to try this setting a few times
        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=False)                '
'
        If Len(AvailableWirelessNetworksData) > 0 Then GoTo Proceed
    Next                                                                            '   Loop back
'
    AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=True)                     '   Run code with elevated privileges
'
' ******************************************
' * Strip the unneeded stuff from the data *
' ******************************************
'
Proceed:
    AvailableWirelessNetworksData = Replace(Replace(Replace(AvailableWirelessNetworksData, _
            " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)                                   ' Remove all spaces,Line feeds, and the like from the results of the clipboard
'
    NumberOfBSSIDs = (Len(AvailableWirelessNetworksData) - _
            Len(Replace(AvailableWirelessNetworksData, "BSSID", ""))) / Len("BSSID")    ' Count the number of BSSIDs in AvailableWirelessNetworksData
'
' ***********************************************
' * Initialize some variables that will be used *
' ***********************************************
'
    HeaderArray = Array("Network Adapter", "   SSID        ", "   Network Type        ", _
            "   Authorization Algorithm        ", "   Encryption        ", _
            "   MAC Address (BSSID)        ", "   Signal        ", "   Radio Type        ", _
            "   Band        ", "   Channel        ", "   RSSI        ", _
             "   Vendor        ")                                                       ' Establish Header names for the columns in the sheet
'
    ReDim ResultArray(1 To NumberOfBSSIDs, 1 To UBound(HeaderArray, 1) + 1)             ' Establish initial dimensions of the ResultArray
'
    ArrayRow = 0                                                                        ' Reset ArrayRow
    IncrementalEndPosition = 1                                                          ' Initialize IncrementalEndPosition value
'
' **********************************************************
' * Start saving the gathered WIFI data to our ResultArray *
' **********************************************************
'
    ResultArray(1, 1) = NetworkAdapterName                                              ' Save the name of the NetworkAdapter into ResultArray
'
    AvailableWirelessNetworksData = Mid$(AvailableWirelessNetworksData, _
            InStr(AvailableWirelessNetworksData, "SSID"))                               ' Find first SSID position
'
    Do While InStr(IncrementalEndPosition, AvailableWirelessNetworksData, "SSID") > 0
        ArrayRow = ArrayRow + 1                                                         '   Increment ArrayRow
'
' Save the SSID
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the SSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Networktype")                           '   Find the end character position of the SSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 2) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the SSID name into the ResultArray
'
        If ResultArray(ArrayRow, 2) = "" Then ResultArray(ArrayRow, 2) = "UnNamed"      '   If the saved SSID name = "" then set the SSID name to "UnNamed"
'
' Save the Networktype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Networktype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Networktype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Authentication")                        '   Find the end character position of the Networktype in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 3) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Networktype into the ResultArray
'
' Save the Authentication
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Authentication"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Authentication in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Encryption")                            '   Find the end character position of the Authentication in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 4) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Authentication into the ResultArray
'
' Save the Encryption
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Encryption"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Encryption in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "BSSID")                                 '   Find the end character position of the Encryption in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 5) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Encryption into the ResultArray
'
GetBSSIDdata:
' Save the MAC Address (BSSID)
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "BSSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the BSSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Signal")                                '   Find the end character position of the BSSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 6) = UCase(Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition))                                              '   Save the BSSID into the ResultArray
'
' Save the Signal level
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Signal"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Signal in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Radiotype")                             '   Find the end character position of the Signal in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 7) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Signal into the ResultArray
'
' Save the Radiotype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Radiotype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Radiotype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Band")                                  '   Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
        If IncrementalEndPosition = 0 Then                                              '   If 'Band' wasn't found then ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
            BandNotFound = True                                                         '       Set BandNotFound flag = True
        End If
'
        ResultArray(ArrayRow, 8) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '       Save the Radiotype into the ResultArray

'
' Save the Band if found
        If BandNotFound Then                                                            '   If 'Band' wasn't found then do nothing in this section
        Else                                                                            '   Else ...
            IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                    AvailableWirelessNetworksData, "Band"), _
                    AvailableWirelessNetworksData, ":") + 1                             '       Find the start character position of the Band in AvailableWirelessNetworksData
'
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Band in AvailableWirelessNetworksData
'
            ResultArray(ArrayRow, 9) = Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition, IncrementalEndPosition - _
                    IncrementalStartPosition)                                           '       Save the Band into the ResultArray
        End If
'
' Save the Channel & maybe calculated Band
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Channel"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Channel in AvailableWirelessNetworksData
'
        If InStr(IncrementalStartPosition, AvailableWirelessNetworksData, "H") > 0 Then '   If there is data after the Channel data that starts with "H" then ...
            IncrementalEndPosition = Application.Min(InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B"), InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "H"))                                '       Find the end character position of the Channel in AvailableWirelessNetworksData
        Else                                                                            '   Else ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B")                                 '       Find the end character position of the Channel in AvailableWirelessNetworksData
        End If
'
        ResultArray(ArrayRow, 10) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Channel into the ResultArray
'
        If BandNotFound Then                                                            '   If the BSS data did not contain data for the 'Band' then ...
            If CInt(ResultArray(ArrayRow, 10)) < 15 Then                                '       If the integer value of the channel is lass than 15 then ...
                ResultArray(ArrayRow, 9) = "2.4GHZ"                                     '           Save "2.4GHZ" to the 'Band' column of ResultArray
            Else                                                                        '       Else ...
                ResultArray(ArrayRow, 9) = "5GHZ"                                       '           Save "5GHZ" to the 'Band' column of ResultArray
            End If
'
            BandNotFound = False                                                        '       Set BandNotFound flag back to False
        End If
'
' Save the Vendor
        If DisplayVendor Then                                                           '   If the User chose to get the vendors associated with the MAC Addresses then ...
            ResultArray(ArrayRow, 12) = GetRouterBrand(ResultArray(ArrayRow, 6), _
                    VendorDelay)                                                        '       Save the Vendor according to the Mac Address
        End If
'
' **************************************************
' * Check for additional BSSID's for the same SSID *
' **************************************************
'
        IncrementalStartPosition = InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID")                                  '   Check for additional BSSIDs
'
        If IncrementalStartPosition <> 0 Then                                           '   If another 'SSID' is found in AvailableWirelessNetworksData then ...
            If Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition - 1, 1) = "B" Then                         '       If the found 'SSID' in AvailableWirelessNetworksData is preceded by 'B" then
                ArrayRow = ArrayRow + 1                                                 '           Increment ArrayRow
'
                ResultArray(ArrayRow, 2) = ResultArray(ArrayRow - 1, 2)                 '           Save the previous SSID into the next row of ResultArray
                ResultArray(ArrayRow, 4) = ResultArray(ArrayRow - 1, 4)                 '           Save the previous Authorization into the next row of ResultArray
                ResultArray(ArrayRow, 5) = ResultArray(ArrayRow - 1, 5)                 '           Save the previous Encryption into the next row of ResultArray
                ResultArray(ArrayRow, 3) = ResultArray(ArrayRow - 1, 3)                 '           Save the previous Networktype into the next row of ResultArray
'
                GoTo GetBSSIDdata                                                       '           Jump to GetBSSIDdata
            End If
        End If
    Loop                                                                                ' Loop back
'
' ************************************************
' * Display the final results, format data, etc. *
' ************************************************
'
    WlanCloseHandle lHandle, ByVal 0                                                    '
'
    For ResultArrayRow = 1 To UBound(ResultArray, 1)                                    ' Loop through the rows of ResultArray
        For ArrayRow = 1 To UBound(WLAN_BSS_ENTRY_Array, 1)                             '   Loop through the rows of WLAN_BSS_ENTRY_Array
            If UCase(WLAN_BSS_ENTRY_Array(ArrayRow, 1)) = _
                    UCase(ResultArray(ResultArrayRow, 6)) Then                          '       If we find a matching MAC Address then ...
                ResultArray(ResultArrayRow, 11) = WLAN_BSS_ENTRY_Array(ArrayRow, 2)     '           Save the corresponding RSSI value to ResultArray
            End If
        Next                                                                            '   Loop back
    Next                                                                                ' Loop back
'
    With ws
        .Cells.Delete                                                                   '   Delete any previous results from the sheet
'
        With .Range("A1").Resize(, UBound(HeaderArray, 1) + 1)
            .Value2 = HeaderArray                                                       '       Display the HeaderArray to the sheet
            .HorizontalAlignment = xlCenter                                             '       Center the Headers horizontally in the cells
              .VerticalAlignment = xlCenter                                             '       Center the Headers vertically in the cells
                 .Font.FontStyle = "Bold"                                               '       Bold the Headers
        End With
'
        .Range("A2").Resize(UBound(ResultArray, 1), UBound(ResultArray, 2)) = ResultArray ' Display the ResultArray to the sheet
'
        If .AutoFilterMode Then .AutoFilterMode = False                                 '   If there is filtered data on the sheet then remove the filter
'
        With .Range(.Cells(1, 2), .Cells(.Rows.Count, .Cells(1, .Columns.Count).End(xlToLeft).Column))
            .Cells.Sort Key1:=.Columns(9), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to Channel Column J values lowest to highest
            .Cells.Sort Key1:=.Columns(10), Order1:=xlDescending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to RSSI Column K values highest to lowest
            .AutoFilter                                                                 '       add AutoFilter option to the sheet
        End With
'
' Now we need to rearrange the columns on the sheet to the preferred order of the columns
'
        MyPreferredOrderOfColumnHeadersArray = Array(1, 2, 6, 9, 7, 11, 10, 8, 12, 4, 5, 3)
'
        .Range("A1").Resize(.Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, _
                UBound(MyPreferredOrderOfColumnHeadersArray) + 1) = Application.Index(.Cells, _
                Evaluate("ROW(1:" & .Cells.Find("*", , xlFormulas, , xlRows, _
                xlPrevious).Row & ")"), MyPreferredOrderOfColumnHeadersArray)           '
'
        .Range("G2:G" & ArrayRow + 1).NumberFormat = "0"                                '   Format used cells in Column G as Whole numbers
        .Range("E2:E" & ArrayRow + 1).NumberFormat = "0%"                               '   Format used cells in Column E as percentages
        .Range("D2:G" & ArrayRow + 1).HorizontalAlignment = xlCenter                    '   Center the data in columns D:G horizontally in the cells
'
        .UsedRange.EntireColumn.AutoFit                                                 '   Autofit the used columns widths of the sheet
    End With
'
    MsgBox "Complete!"                                                                  '
End Sub


Function GetRouterBrand(ByVal MacAddr As String, Optional ByVal VendorDelay As Long = 1000) As String
'
    Dim WebSite             As String                                                   ' Variable to hold the URL of the website for MAC address lookup
    Dim XML_HTTP            As Object                                                   ' Object variable for making HTTP requests
'
    Sleep VendorDelay                                                                   ' Delay to ensure proper processing
'
' Construct the URL for MAC address lookup using the first 8 characters of the MAC address
    WebSite = "https://api.macvendors.com/" & Left$(MacAddr, 8)                         ' <--- Set this to the website to get data from
'
    Set XML_HTTP = CreateObject("MSXML2.XMLHTTP")                                       ' Create an instance of the XMLHTTP object
'
' Send an HTTP GET request to the website to retrieve the router brand information
    With XML_HTTP
        .Open "Get", WebSite, False                                                     '   Open a GET request to the specified URL
        .send                                                                           '   Send the request
    End With
'
    If XML_HTTP.responsetext = "{""errors"":{""detail"":""Not Found""}}" Then           ' If the Vendor was not found then ...
        GetRouterBrand = "Vendor Not Found"                                             '   Return "Vendor Not Found" if vendor information is not available
    Else                                                                                ' Else ...
        GetRouterBrand = XML_HTTP.responsetext                                          '   Return the router brand information received from the website
    End If
End Function


Function Get_BSSID_Data(Optional ByVal Admin As Boolean) As String                      ' Compliments of Jaafar Tribak
'
    Dim sTempTextFile   As String
    Dim TEMP_VBS_FILE   As Variant
    Dim ObjFile         As Object
    Dim objFSO          As Object
    Dim ObjShell        As Object
'
    TEMP_VBS_FILE = Environ("TEMP") & "\BSSID.vbs"
'
    Call CreateTempVBS(TEMP_VBS_FILE)
'
    sTempTextFile = Replace(TEMP_VBS_FILE, ".vbs", ".txt")
'
    Set ObjShell = CreateObject("Shell.Application")
    ObjShell.ShellExecute "cscript", TEMP_VBS_FILE, "", IIf(Admin, "runas", ""), 0&
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
'
    With objFSO
        Set ObjFile = .CreateTextFile(sTempTextFile, True)
        Set ObjFile = .OpenTextFile(sTempTextFile, 1&)
'
        Call Sleep(1000)
'
        If Not ObjFile.AtEndOfStream Then Get_BSSID_Data = ObjFile.ReadAll
'
        ObjFile.Close
'
        .DeleteFile sTempTextFile
        .DeleteFile TEMP_VBS_FILE
    End With
End Function


Sub CreateTempVBS(ByVal FilePathName As String)                                         ' Compliments of Jaafar Tribak
    Dim sVBSCode As String
    Dim objFSO As Object, ObjFile As Object
 
    sVBSCode = "Set ObjShell = CreateObject(""Wscript.Shell"")" & vbCrLf
    sVBSCode = sVBSCode & "strCommand =""netsh wlan show network mode=bssid""" & vbCrLf
    sVBSCode = sVBSCode & "Set objExecObject = ObjShell.Exec(strCommand)" & vbCrLf
    sVBSCode = sVBSCode & "Do While Not objExecObject.StdOut.AtEndOfStream" & vbCrLf
    sVBSCode = sVBSCode & "strText = objExecObject.StdOut.ReadAll()" & vbCrLf
    sVBSCode = sVBSCode & "Loop" & vbCrLf
    sVBSCode = sVBSCode & "ResultFile =" & Chr(34) & _
               Replace(FilePathName, ".vbs", ".txt") & Chr(34) & vbCrLf
    sVBSCode = sVBSCode & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    sVBSCode = sVBSCode & "Set ObjFile = objFSO.CreateTextFile(""" & _
               Replace(FilePathName, ".vbs", ".txt") & """, True)" & vbCrLf
    sVBSCode = sVBSCode & "objFile.Close" & vbCrLf
    sVBSCode = sVBSCode & "Set objFile = objFSO.OpenTextFile(ResultFile, 2)" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Write strText" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Close"
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ObjFile = objFSO.CreateTextFile(FilePathName, True)
    ObjFile.Close
'
    Set ObjFile = objFSO.OpenTextFile(FilePathName, 2&)
    ObjFile.Write sVBSCode
    ObjFile.Close
End Sub

This code will try the unelevated code a few times prior to resorting to to using elevated code.

Please let me know how that works out.

I think I have incorporated most if not all other changes that you suggested, let me know if I missed any please,
 
Upvote 0
Checking unelevated code a few times prior to resorting to to using elevated code is good and will work.

You had a few bugs in the code which I have addressed.

1- the ws argument is optional so in case it is omitted, I have added the following sanity check in the GetBSS SUB :
VBA Code:
If ws Is Nothing Then Set ws = ActiveSheet

2- WlanFreeMemory was not called so I added it at the end of the SUB along with WlanCloseHandle in the CleanUp section :
VBA Code:
CleanUp:

    WlanFreeMemory WirelessInterfaceList
    WlanFreeMemory BSS_Pointer_Address
    WlanCloseHandle lHandle, ByVal 0

3- The code will crash the entire excel application if no network adapter is found. I have added this line to check for that eventuality and exit the sub w/o crashing:
VBA Code:
If udtList.dwNumberofItems = 0 Then
      MsgBox "No Wireless Adapters Found."
      GoTo CleanUp
    End If       
    Sleep 4500

4- In case elevated privileges are required and the user UAC notification is enabled then the code will crash if No is chosen from the Windows Shield popup... I have added the following check to cater for this specific scenarion and avoid the crashing:
VBA Code:
    If Len(AvailableWirelessNetworksData) = 0 Then
        MsgBox "Failed to get Available Wireless Networks Data." & vbCrLf & vbCrLf & _
               "Elevated Privileges may be required to perform this action.", vbCritical
        GoTo CleanUp
    End If
'
' ******************************************
' * Strip the unneeded stuff from the data *
' ******************************************
'
Proceed:


This is the improved code version I would use : (with the found bugs mentioned above all fixed)
VBA Code:
Option Explicit
'
#If VBA7 Then                                                                               'Conditional compilation directive for VBA version 7 or higher
    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 a function to open a handle to WLAN (Wireless Local Area Network)
    Declare PtrSafe Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pdwReserved As LongPtr) As Long           ' Declare a function to close a handle to WLAN
    Declare PtrSafe Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pReserved As LongPtr, _
            ppInterfaceList As LongPtr) As Long                                             ' Declare a function to enumerate WLAN interfaces
    Declare PtrSafe Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGuid As GUID, _
            pDot11Ssid As LongPtr, pIeData As LongPtr, reserved As LongPtr) As Long         ' Declare a function to initiate a WLAN scan
    Declare PtrSafe Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGui As GUID, _
            ByVal pDot11Ssid As Long, ByVal dot11BssType As LongPtr, _
            ByVal bSecurityEnabled As LongPtr, ByVal pReserved As LongPtr, _
            ppWlanBssList As LongPtr) As Long                                               ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
   Declare PtrSafe Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As LongPtr)         ' Declare a sub to free memory allocated by WLAN functions
    Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As LongPtr)                     ' Declare a sub to copy memory from source to destination
    Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)             ' Declare a sub to pause execution for a specified time in milli-seconds
#Else
    Declare Function WlanOpenHandle Lib "wlanapi.dll" ( _
            ByVal dwClientVersion As Long, ByVal pdwReserved As Long, _
            ByRef pdwNegotiaitedVersion As Long, ByRef phClientHandle As Long) As Long      ' Declare a function to open a handle to WLAN (Wireless Local Area Network)
    Declare Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pdwReserved As Long) As Long                 ' Declare a function to close a handle to WLAN
    Declare Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pReserved As Long, _
            ppInterfaceList As Long) As Long                                                ' Declare a function to enumerate WLAN interfaces
    Declare Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGuid As GUID, _
            pDot11Ssid As Long, pIeData As Long, reserved As Long) As Long                  ' Declare a function to initiate a WLAN scan
    Declare Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGui As GUID, ByVal pDot11Ssid As Long, _
            ByVal dot11BssType As Long, ByVal bSecurityEnabled As Long, _
            ByVal pReserved As Long, ppWlanBssList As Long) As Long                         ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)                    ' Declare a sub to free memory allocated by WLAN functions
    Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As Long)                        ' Declare a sub to copy memory from source to destination
    Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)                     ' Declare a sub to pause execution for a specified time in milli-seconds
#End If
'
' Define a custom data type for storing information about a Wi-Fi SSID (Service Set Identifier)
Private Type DOT11_SSID
    uSSIDLength                 As Long                                                     ' Length of the SSID
    ucSSID(31)                  As Byte                                                     ' Array of bytes representing the SSID (up to 32 characters)
End Type
'
' Define an enumeration for different types of Wi-Fi Basic Service Set (BSS)
Private Enum DOT11_BSS_TYPE
    dot11_BSS_type_infrastructure = 1                                                       ' Infrastructure BSS (Connected to an access point)
       dot11_BSS_type_independent = 2                                                       ' Independent BSS (Ad-hoc network)
               DOT11_BSS_TYPE_ANY = 3                                                       ' Any BSS type
End Enum
'
' Define an enumeration for different types of Wi-Fi PHY (Physical) modes
Private Enum DOT11_PHY_TYPE
       dot11_phy_type_unknown = 0                                                           ' Unknown PHY type
           dot11_phy_type_any = 0                                                           ' Any PHY type
          dot11_phy_type_fhss = 1                                                           ' Frequency Hopping Spread Spectrum (FHSS)
          dot11_phy_type_dsss = 2                                                           ' Direct Sequence Spread Spectrum (DSSS)
    dot11_phy_type_irbaseband = 3                                                           ' Infrared Baseband
          dot11_phy_type_ofdm = 4                                                           ' Orthogonal Frequency Division Multiplexing (OFDM)
        dot11_phy_type_hrdsss = 5                                                           ' High-Rate DSSS (HRDSSS)
           dot11_phy_type_erp = 6                                                           ' Extended Rate PHY (ERP)
            dot11_phy_type_ht = 7                                                           ' High Throughput PHY (HT)
           dot11_phy_type_vht = 8                                                           ' Very High Throughput PHY (VHT)
     dot11_phy_type_IHV_start = &H80000000                                                  ' Start of vendor-specific PHY types
       dot11_phy_type_IHV_end = &HFFFFFFFF                                                  ' End of vendor-specific PHY types
End Enum
'
' Define a custom data type for storing FILETIME, a 64-bit value representing date and time
Private Type FILETIME
    dwLowDateTime               As Long                                                     ' Low-order bits of the file time
    dwHighDateTime              As Long                                                     ' High-order bits of the file time
End Type
'
' Define a custom data type for storing information about a Wi-Fi rate set
Private Type WLAN_RATE_SET
    uRateSetLength              As Long                                                     ' Length of the rate set
    usRateSet(125)              As Integer                                                  ' Array of integers representing supported rates
End Type
'
' Define a custom data type for storing a GUID (Globally Unique Identifier)
Private Type GUID
    data1                       As Long                                                     ' First 4 bytes of the GUID
    data2                       As Integer                                                  ' Next 2 bytes of the GUID
    data3                       As Integer                                                  ' Next 2 bytes of the GUID
    data4(7)                    As Byte                                                     ' Last 8 bytes of the GUID
End Type
'
' Define a custom data type for storing information about a Wi-Fi interface
Private Type WLAN_INTERFACE_INFO
    ifGuid                      As GUID                                                     ' GUID of the Wi-Fi interface
    InterfaceDescription(511)   As Byte                                                     ' Description of the interface (up to 512 characters)
    IsState                     As Long                                                     ' State of the interface
End Type
'
' Define a custom data type for storing a list of Wi-Fi interface information
Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberofItems             As Long                                                     ' Number of items in the list
    dwIndex                     As Long                                                     ' Index of the item
    InterfaceInfo               As WLAN_INTERFACE_INFO                                      ' Wi-Fi interface information
End Type
'
' Define a custom data type for storing a list of Wi-Fi Basic Service Set (BSS) information
Private Type WLAN_BSS_LIST
    dwTotalSize                 As Long                                                     ' Total size of the list
    dwNumberofItems             As Long                                                     ' Number of items in the list
    wlanBssEntries              As Long                                                     ' Pointer to BSS entries
End Type
'
' Define a custom data type for storing information about a Wi-Fi Basic Service Set (BSS) entry
Private Type WLAN_BSS_ENTRY
    dot11Ssid                   As DOT11_SSID                                               ' SSID of the BSS
    uPhyId                      As Long                                                     ' PHY ID of the BSS
    dot11Bssid(7)               As Byte                                                     ' BSSID (MAC address) of the BSS
    dot11BssType                As DOT11_BSS_TYPE                                           ' Type of BSS (Infrastructure, Independent, etc.)
    dot11BssPhyType             As DOT11_PHY_TYPE                                           ' PHY type of the BSS
    lRssi                       As Long                                                     ' Received Signal Strength Indicator (RSSI)
    uLinkQuality                As Long                                                     ' Link quality
    bInRegDomain                As Long                                                     ' Indicates if the BSS is in the regulatory domain
    usBeaconPeriod              As Long                                                     ' Beacon period
    ullTimestamp                As FILETIME                                                 ' Timestamp of the BSS
    ullHostTimestamp            As FILETIME                                                 ' Host timestamp
    usCapabilityInformation     As Long                                                     ' Capability information
    ulChCenterFrequency         As Long                                                     ' Center frequency of the channel
    wlanRateSet                 As WLAN_RATE_SET                                            ' Rate set supported by the BSS
    ulIeOffset                  As Long                                                     ' Information Element offset
    ulIeSize                    As Long                                                     ' Information Element size
End Type
'
Private lVersion                As Long
Public lHandle                  As LongPtr
Private udtBSSList              As WLAN_BSS_LIST
Private udtList                 As WLAN_INTERFACE_INFO_LIST


Sub GetInfoAboutWifiNetworksNearMe()
'
    Dim DisplayWorksheet    As Worksheet
'
    Set DisplayWorksheet = Sheets("Sheet1")                                                 ' Set the DisplayWorksheet to the sheet that you want to display final results to
'
    Call GetBSS(ws:=DisplayWorksheet, DisplayVendor:=False)                                     ' <--- Set the DisplayVendor to False if you don't want to convert each
'                                                                                           '       MAC Address to a Vendor, Set to True if you do ... a True setting will
'                                                                                           '       add to the amount of time that the script takes to complete
'                                                                                           '       directly proportianal to the amount of MAC Addresses that have been found
End Sub


Sub GetBSS(Optional ByVal ws As Worksheet, Optional ByVal DisplayVendor As Boolean = False)
'
    Dim BandNotFound                            As Boolean
    Dim API_Call_Error_Value                    As Long
    Dim ArrayRow                                As Long, ResultArrayRow             As Long
    Dim IncrementalEndPosition                  As Long, IncrementalStartPosition   As Long
    Dim NonElevatedTry                          As Long
    Dim NumberOfBSSIDs                          As Long
    Dim SSID_Length                             As Long
    Dim VendorDelay                             As Long
    Dim BSS_Pointer_Address                     As LongPtr, BSS_Data_Start_Address  As LongPtr
    Dim WirelessInterfaceList                   As LongPtr
    Dim AvailableWirelessNetworksData           As String, NetworkAdapterName       As String
    Dim HeaderArray                             As Variant, ResultArray()           As Variant
    Dim MyPreferredOrderOfColumnHeadersArray    As Variant
    Dim WLAN_BSS_ENTRY_Array()                  As Variant
    Dim udtBSS                                  As WLAN_BSS_ENTRY
'
    VendorDelay = 1000                                                                  ' <--- Set this to the delay in milliseconds (1000 = 1 second) to get vendor data from site
'
'   NOTE: This code currently only processes the first wireless adapter
'
    API_Call_Error_Value = WlanOpenHandle(2&, 0&, lVersion, lHandle)                    ' Open a handle to the wireless interface
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If we didn't get handle then exit sub
'
    API_Call_Error_Value = WlanEnumInterfaces(ByVal lHandle, 0&, WirelessInterfaceList)   ' Enumerate available wireless interfaces and retrieve the list
    If API_Call_Error_Value <> 0 Then GoTo CleanUp                                       ' If error occurred then exit sub
'
    Call CopyMemory(udtList, ByVal WirelessInterfaceList, LenB(udtList))                ' Copy WirelessInterfaceList data to udtList
'
    NetworkAdapterName = StrConv(udtList.InterfaceInfo.InterfaceDescription, vbUnicode)
    NetworkAdapterName = StrConv(NetworkAdapterName, vbFromUnicode)                     ' Convert the NetworkAdapterName string from Unicode to the system's default character set
'
    If InStr(NetworkAdapterName, Chr(0&)) - 1& > 0 Then
        NetworkAdapterName = Left$(NetworkAdapterName, _
                InStr(NetworkAdapterName, Chr(0&)) - 1&)                                '   Return the substring of the NetworkAdapterName string up to the null character position
    End If
'
    API_Call_Error_Value = WlanScan(lHandle, udtList.InterfaceInfo.ifGuid, ByVal 0&, _
            ByVal 0&, ByVal 0&)                                                         ' Refresh the list of available wireless networks by calling the WlanScan function
        
    If udtList.dwNumberofItems = 0 Then
      MsgBox "No Wireless Adapters Found."
      GoTo CleanUp
    End If
        
    Sleep 4500                                                                          ' Sleep for 4500 milliseconds (4.5 seconds)
'
    API_Call_Error_Value = WlanGetNetworkBssList(lHandle, udtList.InterfaceInfo.ifGuid, _
            ByVal 0&, DOT11_BSS_TYPE.DOT11_BSS_TYPE_ANY, 0, 0, BSS_Pointer_Address)
            ' Get the BSS (Basic Service Set) data using the WlanGetNetworkBssList function
        
    CopyMemory udtBSSList, ByVal BSS_Pointer_Address, Len(udtBSSList)                   ' Copy the BSS data from the pointer address to the udtBSSList structure
'
    If API_Call_Error_Value Then                                                        ' If an error occurred obtaining the BSS data then ...
        Debug.Print "Error: "; CStr(API_Call_Error_Value)                               '   Display error to 'Immediate' window (CTRL+G in VBE window)
        MsgBox "No BSS Info Available!"                                                 '   Display pop up to user
    Else                                                                                ' Else ...
        BSS_Data_Start_Address = BSS_Pointer_Address + 8                                '   Initialize BSS_Data_Start_Address
'
        ReDim WLAN_BSS_ENTRY_Array(1 To udtBSSList.dwNumberofItems, 1 To 2)             '   Establish dimensions of WLAN_BSS_ENTRY_Array
'
        Do                                                                              '   Loop through the BSS entries and extract relevant information
            CopyMemory udtBSS, ByVal BSS_Data_Start_Address, Len(udtBSS)                '       Copy the BSS data to the udtBSS structure
'
            ArrayRow = ArrayRow + 1                                                     '       Increment ArrayRow
'
            WLAN_BSS_ENTRY_Array(ArrayRow, 1) = Right$("0" & Hex$(udtBSS.dot11Bssid(0)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(1)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(2)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(3)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(4)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(5)), 2)                       '       Convert each byte of the MAC address to a two-digit hexadecimal representation
'                                                                                       '               and concatenate them with ":" separators
            WLAN_BSS_ENTRY_Array(ArrayRow, 2) = udtBSS.lRssi                            '       Save the RSSI to WLAN_BSS_ENTRY_Array
'
            BSS_Data_Start_Address = BSS_Data_Start_Address + Len(udtBSS)               '       Increment BSS_Data_Start_Address to the next BSS entry
        Loop Until ArrayRow = udtBSSList.dwNumberofItems                                '   Loop back if there are more BSS entries
'
'        WlanFreeMemory BSS_Pointer_Address                                               '   Free the memory allocated for BSS data
    End If
'
' **********************************************
' * Gather the available WIFI connections data *
' **********************************************
'
    For NonElevatedTry = 1 To 3                                                     '   Loop to try this setting a few times
        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=False)                '
'
        If Len(AvailableWirelessNetworksData) > 0 Then GoTo Proceed
    Next                                                                            '   Loop back
''
    AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=True)                     '   Run code with elevated privileges
 
    If Len(AvailableWirelessNetworksData) = 0 Then
        MsgBox "Failed to get Available Wireless Networks Data." & vbCrLf & vbCrLf & _
               "Elevated Privileges may be required to perform this action.", vbCritical
        GoTo CleanUp
    End If
'
' ******************************************
' * Strip the unneeded stuff from the data *
' ******************************************
'
Proceed:
    AvailableWirelessNetworksData = Replace(Replace(Replace(AvailableWirelessNetworksData, _
            " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)                                   ' Remove all spaces,Line feeds, and the like from the results of the clipboard
'
    NumberOfBSSIDs = (Len(AvailableWirelessNetworksData) - _
            Len(Replace(AvailableWirelessNetworksData, "BSSID", ""))) / Len("BSSID")    ' Count the number of BSSIDs in AvailableWirelessNetworksData
        
'
' ***********************************************
' * Initialize some variables that will be used *
' ***********************************************
'
    HeaderArray = Array("Network Adapter", "   SSID        ", "   Network Type        ", _
            "   Authorization Algorithm        ", "   Encryption        ", _
            "   MAC Address (BSSID)        ", "   Signal        ", "   Radio Type        ", _
            "   Band        ", "   Channel        ", "   RSSI        ", _
             "   Vendor        ")                                                       ' Establish Header names for the columns in the sheet
'
    ReDim ResultArray(1 To NumberOfBSSIDs, 1 To UBound(HeaderArray, 1) + 1)             ' Establish initial dimensions of the ResultArray
'
    ArrayRow = 0                                                                        ' Reset ArrayRow
    IncrementalEndPosition = 1                                                          ' Initialize IncrementalEndPosition value
'
' **********************************************************
' * Start saving the gathered WIFI data to our ResultArray *
' **********************************************************
'
    ResultArray(1, 1) = NetworkAdapterName                                              ' Save the name of the NetworkAdapter into ResultArray
'
    AvailableWirelessNetworksData = Mid$(AvailableWirelessNetworksData, _
            InStr(AvailableWirelessNetworksData, "SSID"))                               ' Find first SSID position
'
    Do While InStr(IncrementalEndPosition, AvailableWirelessNetworksData, "SSID") > 0
        ArrayRow = ArrayRow + 1                                                         '   Increment ArrayRow
'
' Save the SSID
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the SSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Networktype")                           '   Find the end character position of the SSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 2) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the SSID name into the ResultArray
'
        If ResultArray(ArrayRow, 2) = "" Then ResultArray(ArrayRow, 2) = "UnNamed"      '   If the saved SSID name = "" then set the SSID name to "UnNamed"
'
' Save the Networktype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Networktype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Networktype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Authentication")                        '   Find the end character position of the Networktype in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 3) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Networktype into the ResultArray
'
' Save the Authentication
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Authentication"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Authentication in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Encryption")                            '   Find the end character position of the Authentication in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 4) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Authentication into the ResultArray
'
' Save the Encryption
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Encryption"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Encryption in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "BSSID")                                 '   Find the end character position of the Encryption in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 5) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Encryption into the ResultArray
'
GetBSSIDdata:
' Save the MAC Address (BSSID)
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "BSSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the BSSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Signal")                                '   Find the end character position of the BSSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 6) = UCase(Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition))                                              '   Save the BSSID into the ResultArray
'
' Save the Signal level
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Signal"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Signal in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Radiotype")                             '   Find the end character position of the Signal in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 7) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Signal into the ResultArray
'
' Save the Radiotype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Radiotype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Radiotype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Band")                                  '   Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
        If IncrementalEndPosition = 0 Then                                              '   If 'Band' wasn't found then ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
            BandNotFound = True                                                         '       Set BandNotFound flag = True
        End If
'
        ResultArray(ArrayRow, 8) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '       Save the Radiotype into the ResultArray

'
' Save the Band if found
        If BandNotFound Then                                                            '   If 'Band' wasn't found then do nothing in this section
        Else                                                                            '   Else ...
            IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                    AvailableWirelessNetworksData, "Band"), _
                    AvailableWirelessNetworksData, ":") + 1                             '       Find the start character position of the Band in AvailableWirelessNetworksData
'
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Band in AvailableWirelessNetworksData
'
            ResultArray(ArrayRow, 9) = Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition, IncrementalEndPosition - _
                    IncrementalStartPosition)                                           '       Save the Band into the ResultArray
        End If
'
' Save the Channel & maybe calculated Band
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Channel"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Channel in AvailableWirelessNetworksData
'
        If InStr(IncrementalStartPosition, AvailableWirelessNetworksData, "H") > 0 Then '   If there is data after the Channel data that starts with "H" then ...
            IncrementalEndPosition = Application.Min(InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B"), InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "H"))                                '       Find the end character position of the Channel in AvailableWirelessNetworksData
        Else                                                                            '   Else ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B")                                 '       Find the end character position of the Channel in AvailableWirelessNetworksData
        End If
'
        ResultArray(ArrayRow, 10) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Channel into the ResultArray
'
        If BandNotFound Then                                                            '   If the BSS data did not contain data for the 'Band' then ...
            If CInt(ResultArray(ArrayRow, 10)) < 15 Then                                '       If the integer value of the channel is lass than 15 then ...
                ResultArray(ArrayRow, 9) = "2.4GHZ"                                     '           Save "2.4GHZ" to the 'Band' column of ResultArray
            Else                                                                        '       Else ...
                ResultArray(ArrayRow, 9) = "5GHZ"                                       '           Save "5GHZ" to the 'Band' column of ResultArray
            End If
'
            BandNotFound = False                                                        '       Set BandNotFound flag back to False
        End If
'
' Save the Vendor
        If DisplayVendor Then                                                           '   If the User chose to get the vendors associated with the MAC Addresses then ...
            ResultArray(ArrayRow, 12) = GetRouterBrand(ResultArray(ArrayRow, 6), _
                    VendorDelay)                                                        '       Save the Vendor according to the Mac Address
        End If
'
' **************************************************
' * Check for additional BSSID's for the same SSID *
' **************************************************
'
        IncrementalStartPosition = InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID")                                  '   Check for additional BSSIDs
'
        If IncrementalStartPosition <> 0 Then                                           '   If another 'SSID' is found in AvailableWirelessNetworksData then ...
            If Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition - 1, 1) = "B" Then                         '       If the found 'SSID' in AvailableWirelessNetworksData is preceded by 'B" then
                ArrayRow = ArrayRow + 1                                                 '           Increment ArrayRow
'
                ResultArray(ArrayRow, 2) = ResultArray(ArrayRow - 1, 2)                 '           Save the previous SSID into the next row of ResultArray
                ResultArray(ArrayRow, 4) = ResultArray(ArrayRow - 1, 4)                 '           Save the previous Authorization into the next row of ResultArray
                ResultArray(ArrayRow, 5) = ResultArray(ArrayRow - 1, 5)                 '           Save the previous Encryption into the next row of ResultArray
                ResultArray(ArrayRow, 3) = ResultArray(ArrayRow - 1, 3)                 '           Save the previous Networktype into the next row of ResultArray
'
                GoTo GetBSSIDdata                                                       '           Jump to GetBSSIDdata
            End If
        End If
    Loop                                                                                ' Loop back
'
' ************************************************
' * Display the final results, format data, etc. *
' ************************************************
'
'    WlanCloseHandle lHandle, ByVal 0                                                    '
'
    For ResultArrayRow = 1 To UBound(ResultArray, 1)                                    ' Loop through the rows of ResultArray
        For ArrayRow = 1 To UBound(WLAN_BSS_ENTRY_Array, 1)                             '   Loop through the rows of WLAN_BSS_ENTRY_Array
            If UCase(WLAN_BSS_ENTRY_Array(ArrayRow, 1)) = _
                    UCase(ResultArray(ResultArrayRow, 6)) Then                          '       If we find a matching MAC Address then ...
                ResultArray(ResultArrayRow, 11) = WLAN_BSS_ENTRY_Array(ArrayRow, 2)     '           Save the corresponding RSSI value to ResultArray
            End If
        Next                                                                            '   Loop back
    Next                                                                                ' Loop back
'

    If ws Is Nothing Then Set ws = ActiveSheet
    With ws
        .Cells.Delete                                                                   '   Delete any previous results from the sheet
'
        With .Range("A1").Resize(, UBound(HeaderArray, 1) + 1)
            .Value2 = HeaderArray                                                       '       Display the HeaderArray to the sheet
            .HorizontalAlignment = xlCenter                                             '       Center the Headers horizontally in the cells
              .VerticalAlignment = xlCenter                                             '       Center the Headers vertically in the cells
                 .Font.FontStyle = "Bold"                                               '       Bold the Headers
        End With
'
        .Range("A2").Resize(UBound(ResultArray, 1), UBound(ResultArray, 2)) = ResultArray ' Display the ResultArray to the sheet
'
        If .AutoFilterMode Then .AutoFilterMode = False                                 '   If there is filtered data on the sheet then remove the filter
'
        With .Range(.Cells(1, 2), .Cells(.Rows.Count, .Cells(1, .Columns.Count).End(xlToLeft).Column))
            .Cells.Sort Key1:=.Columns(9), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to Channel Column J values lowest to highest
            .Cells.Sort Key1:=.Columns(10), Order1:=xlDescending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to RSSI Column K values highest to lowest
            .AutoFilter                                                                 '       add AutoFilter option to the sheet
        End With
'
' Now we need to rearrange the columns on the sheet to the preferred order of the columns
'
        MyPreferredOrderOfColumnHeadersArray = Array(1, 2, 6, 9, 7, 11, 10, 8, 12, 4, 5, 3)
'
        .Range("A1").Resize(.Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, _
                UBound(MyPreferredOrderOfColumnHeadersArray) + 1) = Application.Index(.Cells, _
                Evaluate("ROW(1:" & .Cells.Find("*", , xlFormulas, , xlRows, _
                xlPrevious).Row & ")"), MyPreferredOrderOfColumnHeadersArray)           '
'
        .Range("G2:G" & ArrayRow + 1).NumberFormat = "0"                                '   Format used cells in Column G as Whole numbers
        .Range("E2:E" & ArrayRow + 1).NumberFormat = "0%"                               '   Format used cells in Column E as percentages
        .Range("D2:G" & ArrayRow + 1).HorizontalAlignment = xlCenter                    '   Center the data in columns D:G horizontally in the cells
'
        .UsedRange.EntireColumn.AutoFit                                                 '   Autofit the used columns widths of the sheet
    End With
 
 
    MsgBox "Complete!"                                                                  '

CleanUp:

    WlanFreeMemory WirelessInterfaceList
    WlanFreeMemory BSS_Pointer_Address
    WlanCloseHandle lHandle, ByVal 0

End Sub


Function GetRouterBrand(ByVal MacAddr As String, Optional ByVal VendorDelay As Long = 1000) As String
'
    Dim WebSite             As String                                                   ' Variable to hold the URL of the website for MAC address lookup
    Dim XML_HTTP            As Object                                                   ' Object variable for making HTTP requests
'
    Sleep VendorDelay                                                                   ' Delay to ensure proper processing
'
' Construct the URL for MAC address lookup using the first 8 characters of the MAC address
    WebSite = "https://api.macvendors.com/" & Left$(MacAddr, 8)                         ' <--- Set this to the website to get data from
'
    Set XML_HTTP = CreateObject("MSXML2.XMLHTTP")                                       ' Create an instance of the XMLHTTP object
'
' Send an HTTP GET request to the website to retrieve the router brand information
    With XML_HTTP
        .Open "Get", WebSite, False                                                     '   Open a GET request to the specified URL
        .send                                                                           '   Send the request
    End With
'
    If XML_HTTP.ResponseText = "{""errors"":{""detail"":""Not Found""}}" Then           ' If the Vendor was not found then ...
        GetRouterBrand = "Vendor Not Found"                                             '   Return "Vendor Not Found" if vendor information is not available
    Else                                                                                ' Else ...
        GetRouterBrand = XML_HTTP.ResponseText                                          '   Return the router brand information received from the website
    End If
End Function


Function Get_BSSID_Data(Optional ByVal Admin As Boolean) As String                      ' Compliments of Jaafar Tribak
'
    Dim sTempTextFile   As String
    Dim TEMP_VBS_FILE   As Variant
    Dim ObjFile         As Object
    Dim objFSO          As Object
    Dim ObjShell        As Object
'
    TEMP_VBS_FILE = Environ("TEMP") & "\BSSID.vbs"
'
    Call CreateTempVBS(TEMP_VBS_FILE)
'
    sTempTextFile = Replace(TEMP_VBS_FILE, ".vbs", ".txt")
'
    Set ObjShell = CreateObject("Shell.Application")
    ObjShell.ShellExecute "cscript", TEMP_VBS_FILE, "", IIf(Admin, "runas", ""), 0&
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
'
    With objFSO
        Set ObjFile = .CreateTextFile(sTempTextFile, True)
        Set ObjFile = .OpenTextFile(sTempTextFile, 1&)
'
        Call Sleep(1000)
'
        If Not ObjFile.AtEndOfStream Then Get_BSSID_Data = ObjFile.ReadAll
'
        ObjFile.Close
'
        .DeleteFile sTempTextFile
        .DeleteFile TEMP_VBS_FILE
    End With
End Function


Sub CreateTempVBS(ByVal FilePathName As String)                                         ' Compliments of Jaafar Tribak
    Dim sVBSCode As String
    Dim objFSO As Object, ObjFile As Object
 
    sVBSCode = "Set ObjShell = CreateObject(""Wscript.Shell"")" & vbCrLf
    sVBSCode = sVBSCode & "strCommand =""netsh wlan show network mode=bssid""" & vbCrLf
    sVBSCode = sVBSCode & "Set objExecObject = ObjShell.Exec(strCommand)" & vbCrLf
    sVBSCode = sVBSCode & "Do While Not objExecObject.StdOut.AtEndOfStream" & vbCrLf
    sVBSCode = sVBSCode & "strText = objExecObject.StdOut.ReadAll()" & vbCrLf
    sVBSCode = sVBSCode & "Loop" & vbCrLf
    sVBSCode = sVBSCode & "ResultFile =" & Chr(34) & _
               Replace(FilePathName, ".vbs", ".txt") & Chr(34) & vbCrLf
    sVBSCode = sVBSCode & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    sVBSCode = sVBSCode & "Set ObjFile = objFSO.CreateTextFile(""" & _
               Replace(FilePathName, ".vbs", ".txt") & """, True)" & vbCrLf
    sVBSCode = sVBSCode & "objFile.Close" & vbCrLf
    sVBSCode = sVBSCode & "Set objFile = objFSO.OpenTextFile(ResultFile, 2)" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Write strText" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Close"
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ObjFile = objFSO.CreateTextFile(FilePathName, True)
    ObjFile.Close
'
    Set ObjFile = objFSO.OpenTextFile(FilePathName, 2&)
    ObjFile.Write sVBSCode
    ObjFile.Close
End Sub

As you know, the code may take a while particularly if DisplayVendor is set to TRUE and when that happens, the UI will temporarly freeze . It would be nice to inform the user beforehand or to have some kind of Wait\Progress on display while the code is running.
 
Last edited:
Upvote 0
I included the latest suggestions including adding code to update the StatusBar when Vendor option is chosen, Lemme know.

VBA Code:
Option Explicit
'
#If VBA7 Then                                                                               'Conditional compilation directive for VBA version 7 or higher
    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 a function to open a handle to WLAN (Wireless Local Area Network)
    Declare PtrSafe Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pdwReserved As LongPtr) As Long           ' Declare a function to close a handle to WLAN
    Declare PtrSafe Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, ByVal pReserved As LongPtr, _
            ppInterfaceList As LongPtr) As Long                                             ' Declare a function to enumerate WLAN interfaces
    Declare PtrSafe Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGuid As GUID, _
            pDot11Ssid As LongPtr, pIeData As LongPtr, reserved As LongPtr) As Long         ' Declare a function to initiate a WLAN scan
    Declare PtrSafe Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As LongPtr, pInterfaceGui As GUID, _
            ByVal pDot11Ssid As Long, ByVal dot11BssType As LongPtr, _
            ByVal bSecurityEnabled As LongPtr, ByVal pReserved As LongPtr, _
            ppWlanBssList As LongPtr) As Long                                               ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare PtrSafe Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As LongPtr)         ' Declare a sub to free memory allocated by WLAN functions
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As LongPtr)                     ' Declare a sub to copy memory from source to destination
    Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)             ' Declare a sub to pause execution for a specified time in milli-seconds
#Else
    Declare Function WlanOpenHandle Lib "wlanapi.dll" ( _
            ByVal dwClientVersion As Long, ByVal pdwReserved As Long, _
            ByRef pdwNegotiaitedVersion As Long, ByRef phClientHandle As Long) As Long      ' Declare a function to open a handle to WLAN (Wireless Local Area Network)
    Declare Function WlanCloseHandle Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pdwReserved As Long) As Long                 ' Declare a function to close a handle to WLAN
    Declare Function WlanEnumInterfaces Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, ByVal pReserved As Long, _
            ppInterfaceList As Long) As Long                                                ' Declare a function to enumerate WLAN interfaces
    Declare Function WlanScan Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGuid As GUID, _
            pDot11Ssid As Long, pIeData As Long, reserved As Long) As Long                  ' Declare a function to initiate a WLAN scan
    Declare Function WlanGetNetworkBssList Lib "wlanapi.dll" ( _
            ByVal hClientHandle As Long, pInterfaceGui As GUID, ByVal pDot11Ssid As Long, _
            ByVal dot11BssType As Long, ByVal bSecurityEnabled As Long, _
            ByVal pReserved As Long, ppWlanBssList As Long) As Long                         ' Declare a function to retrieve the list of available WLAN network BSS (Basic Service Set)
    Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)                    ' Declare a sub to free memory allocated by WLAN functions
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
            Destination As Any, Source As Any, ByVal Length As Long)                        ' Declare a sub to copy memory from source to destination
    Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)                     ' Declare a sub to pause execution for a specified time in milli-seconds
#End If
'
' Define a custom data type for storing information about a Wi-Fi SSID (Service Set Identifier)
Private Type DOT11_SSID
    uSSIDLength                 As Long                                                     ' Length of the SSID
    ucSSID(31)                  As Byte                                                     ' Array of bytes representing the SSID (up to 32 characters)
End Type
'
' Define an enumeration for different types of Wi-Fi Basic Service Set (BSS)
Private Enum DOT11_BSS_TYPE
    dot11_BSS_type_infrastructure = 1                                                       ' Infrastructure BSS (Connected to an access point)
       dot11_BSS_type_independent = 2                                                       ' Independent BSS (Ad-hoc network)
               DOT11_BSS_TYPE_ANY = 3                                                       ' Any BSS type
End Enum
'
' Define an enumeration for different types of Wi-Fi PHY (Physical) modes
Private Enum DOT11_PHY_TYPE
       dot11_phy_type_unknown = 0                                                           ' Unknown PHY type
           dot11_phy_type_any = 0                                                           ' Any PHY type
          dot11_phy_type_fhss = 1                                                           ' Frequency Hopping Spread Spectrum (FHSS)
          dot11_phy_type_dsss = 2                                                           ' Direct Sequence Spread Spectrum (DSSS)
    dot11_phy_type_irbaseband = 3                                                           ' Infrared Baseband
          dot11_phy_type_ofdm = 4                                                           ' Orthogonal Frequency Division Multiplexing (OFDM)
        dot11_phy_type_hrdsss = 5                                                           ' High-Rate DSSS (HRDSSS)
           dot11_phy_type_erp = 6                                                           ' Extended Rate PHY (ERP)
            dot11_phy_type_ht = 7                                                           ' High Throughput PHY (HT)
           dot11_phy_type_vht = 8                                                           ' Very High Throughput PHY (VHT)
     dot11_phy_type_IHV_start = &H80000000                                                  ' Start of vendor-specific PHY types
       dot11_phy_type_IHV_end = &HFFFFFFFF                                                  ' End of vendor-specific PHY types
End Enum
'
' Define a custom data type for storing FILETIME, a 64-bit value representing date and time
Private Type FILETIME
    dwLowDateTime               As Long                                                     ' Low-order bits of the file time
    dwHighDateTime              As Long                                                     ' High-order bits of the file time
End Type
'
' Define a custom data type for storing information about a Wi-Fi rate set
Private Type WLAN_RATE_SET
    uRateSetLength              As Long                                                     ' Length of the rate set
    usRateSet(125)              As Integer                                                  ' Array of integers representing supported rates
End Type
'
' Define a custom data type for storing a GUID (Globally Unique Identifier)
Private Type GUID
    data1                       As Long                                                     ' First 4 bytes of the GUID
    data2                       As Integer                                                  ' Next 2 bytes of the GUID
    data3                       As Integer                                                  ' Next 2 bytes of the GUID
    data4(7)                    As Byte                                                     ' Last 8 bytes of the GUID
End Type
'
' Define a custom data type for storing information about a Wi-Fi interface
Private Type WLAN_INTERFACE_INFO
    ifGuid                      As GUID                                                     ' GUID of the Wi-Fi interface
    InterfaceDescription(511)   As Byte                                                     ' Description of the interface (up to 512 characters)
    IsState                     As Long                                                     ' State of the interface
End Type
'
' Define a custom data type for storing a list of Wi-Fi interface information
Private Type WLAN_INTERFACE_INFO_LIST
    dwNumberofItems             As Long                                                     ' Number of items in the list
    dwIndex                     As Long                                                     ' Index of the item
    InterfaceInfo               As WLAN_INTERFACE_INFO                                      ' Wi-Fi interface information
End Type
'
' Define a custom data type for storing a list of Wi-Fi Basic Service Set (BSS) information
Private Type WLAN_BSS_LIST
    dwTotalSize                 As Long                                                     ' Total size of the list
    dwNumberofItems             As Long                                                     ' Number of items in the list
    wlanBssEntries              As Long                                                     ' Pointer to BSS entries
End Type
'
' Define a custom data type for storing information about a Wi-Fi Basic Service Set (BSS) entry
Private Type WLAN_BSS_ENTRY
    dot11Ssid                   As DOT11_SSID                                               ' SSID of the BSS
    uPhyId                      As Long                                                     ' PHY ID of the BSS
    dot11Bssid(7)               As Byte                                                     ' BSSID (MAC address) of the BSS
    dot11BssType                As DOT11_BSS_TYPE                                           ' Type of BSS (Infrastructure, Independent, etc.)
    dot11BssPhyType             As DOT11_PHY_TYPE                                           ' PHY type of the BSS
    lRssi                       As Long                                                     ' Received Signal Strength Indicator (RSSI)
    uLinkQuality                As Long                                                     ' Link quality
    bInRegDomain                As Long                                                     ' Indicates if the BSS is in the regulatory domain
    usBeaconPeriod              As Long                                                     ' Beacon period
    ullTimestamp                As FILETIME                                                 ' Timestamp of the BSS
    ullHostTimestamp            As FILETIME                                                 ' Host timestamp
    usCapabilityInformation     As Long                                                     ' Capability information
    ulChCenterFrequency         As Long                                                     ' Center frequency of the channel
    wlanRateSet                 As WLAN_RATE_SET                                            ' Rate set supported by the BSS
    ulIeOffset                  As Long                                                     ' Information Element offset
    ulIeSize                    As Long                                                     ' Information Element size
End Type
'
Private lVersion                As Long
Public lHandle                  As LongPtr
Private udtBSSList              As WLAN_BSS_LIST
Private udtList                 As WLAN_INTERFACE_INFO_LIST


Sub GetInfoAboutWifiNetworksNearMe()
'
    Dim DisplayWorksheet    As Worksheet
'
    Set DisplayWorksheet = Sheets("Sheet1")                                                 ' <--- Set the DisplayWorksheet to the sheet you want to display final results to
'
    Call GetBSS(DisplayWorksheet, DisplayVendor:=False)                                     ' <--- Set the DisplayVendor to False if you don't want to convert each
'                                                                                           '       MAC Address to a Vendor, Set to True if you do ... a True setting will
'                                                                                           '       add to the amount of time that the script takes to complete
'                                                                                           '       directly proportianal to the amount of MAC Addresses that have been found
End Sub


Sub GetBSS(Optional ByVal ws As Worksheet, Optional ByVal DisplayVendor As Boolean = False)
'
    Dim BandNotFound                            As Boolean
    Dim API_Call_Error_Value                    As Long
    Dim ArrayRow                                As Long, ResultArrayRow             As Long
    Dim IncrementalEndPosition                  As Long, IncrementalStartPosition   As Long
    Dim NonElevatedTry                          As Long
    Dim NumberOfBSSIDs                          As Long
    Dim SSID_Length                             As Long
    Dim VendorDelay                             As Long
    Dim BSS_Pointer_Address                     As LongPtr, BSS_Data_Start_Address  As LongPtr
    Dim WirelessInterfaceList                   As LongPtr
    Dim AvailableWirelessNetworksData           As String, NetworkAdapterName       As String
    Dim HeaderArray                             As Variant, ResultArray()           As Variant
    Dim MyPreferredOrderOfColumnHeadersArray    As Variant
    Dim WLAN_BSS_ENTRY_Array()                  As Variant
    Dim udtBSS                                  As WLAN_BSS_ENTRY
'
    VendorDelay = 1000                                                                  ' <--- Set this to the delay in milliseconds (1000 = 1 second) to get vendor data from site
'
'   NOTE: This code currently only processes the first wireless adapter
'
    API_Call_Error_Value = WlanOpenHandle(2&, 0&, lVersion, lHandle)                    ' Open a handle to the wireless interface
    If API_Call_Error_Value <> 0 Then Exit Sub                                          ' If we didn't get handle then exit sub
'
    API_Call_Error_Value = WlanEnumInterfaces(ByVal lHandle, 0&, WirelessInterfaceList) ' Enumerate available wireless interfaces and retrieve the list
    If API_Call_Error_Value <> 0 Then GoTo CleanUp                                      ' If error occurred then jump to CleanUp
'
    Call CopyMemory(udtList, ByVal WirelessInterfaceList, LenB(udtList))                ' Copy WirelessInterfaceList data to udtList
'
    If udtList.dwNumberofItems = 0 Then                                                 ' If no adapter was found then ...
        MsgBox "No Wireless Adapter Found."                                             '
        GoTo CleanUp                                                                    '   Jump to CleanUp
    End If
'
    NetworkAdapterName = StrConv(udtList.InterfaceInfo.InterfaceDescription, vbUnicode)
    NetworkAdapterName = StrConv(NetworkAdapterName, vbFromUnicode)                     ' Convert the NetworkAdapterName string from Unicode to the system's default character set
'
    If InStr(NetworkAdapterName, Chr(0&)) - 1& > 0 Then
        NetworkAdapterName = Left$(NetworkAdapterName, _
                InStr(NetworkAdapterName, Chr(0&)) - 1&)                                '   Return the substring of the NetworkAdapterName string up to the null character position
    End If
'
    API_Call_Error_Value = WlanScan(lHandle, udtList.InterfaceInfo.ifGuid, ByVal 0&, _
            ByVal 0&, ByVal 0&)                                                         ' Refresh the list of available wireless networks by calling the WlanScan function
    Sleep 4500                                                                          ' Sleep for 4500 milliseconds (4.5 seconds)
'
    API_Call_Error_Value = WlanGetNetworkBssList(lHandle, udtList.InterfaceInfo.ifGuid, _
            ByVal 0&, DOT11_BSS_TYPE.DOT11_BSS_TYPE_ANY, 0, 0, BSS_Pointer_Address)     ' Get the BSS (Basic Service Set) data using the WlanGetNetworkBssList function
    CopyMemory udtBSSList, ByVal BSS_Pointer_Address, Len(udtBSSList)                   ' Copy the BSS data from the pointer address to the udtBSSList structure
'
    If API_Call_Error_Value Then                                                        ' If an error occurred obtaining the BSS data then ...
        Debug.Print "Error: "; CStr(API_Call_Error_Value)                               '   Display error to 'Immediate' window (CTRL+G in VBE window)
        MsgBox "No BSS Info Available!"                                                 '   Display pop up to user
    Else                                                                                ' Else ...
        BSS_Data_Start_Address = BSS_Pointer_Address + 8                                '   Initialize BSS_Data_Start_Address
'
        ReDim WLAN_BSS_ENTRY_Array(1 To udtBSSList.dwNumberofItems, 1 To 2)             '   Establish dimensions of WLAN_BSS_ENTRY_Array
'
        Do                                                                              '   Loop through the BSS entries and extract relevant information
            CopyMemory udtBSS, ByVal BSS_Data_Start_Address, Len(udtBSS)                '       Copy the BSS data to the udtBSS structure
'
            ArrayRow = ArrayRow + 1                                                     '       Increment ArrayRow
'
            WLAN_BSS_ENTRY_Array(ArrayRow, 1) = Right$("0" & Hex$(udtBSS.dot11Bssid(0)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(1)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(2)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(3)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(4)), 2) & ":" _
                    & Right$("0" & Hex$(udtBSS.dot11Bssid(5)), 2)                       '       Convert each byte of the MAC address to a two-digit hexadecimal representation
'                                                                                       '               and concatenate them with ":" separators
            WLAN_BSS_ENTRY_Array(ArrayRow, 2) = udtBSS.lRssi                            '       Save the RSSI to WLAN_BSS_ENTRY_Array
'
            BSS_Data_Start_Address = BSS_Data_Start_Address + Len(udtBSS)               '       Increment BSS_Data_Start_Address to the next BSS entry
        Loop Until ArrayRow = udtBSSList.dwNumberofItems                                '   Loop back if there are more BSS entries
    End If
'
' **********************************************
' * Gather the available WIFI connections data *
' **********************************************
'
    For NonElevatedTry = 1 To 3                                                         ' Loop to try this setting a few times
        AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=False)                    '   Run code with un-elevated privileges
'
        If Len(AvailableWirelessNetworksData) > 0 Then GoTo Proceed                     '   If we received WirelessNetworksData then jump to Proceed
    Next                                                                                ' Loop back
'
    AvailableWirelessNetworksData = Get_BSSID_Data(Admin:=True)                         ' Run code with elevated privileges
'
    If Len(AvailableWirelessNetworksData) = 0 Then                                      ' If we haven't received WirelessNetworksData then ...
        MsgBox "Failed to get Available Wireless Networks Data." & vbCrLf & vbCrLf & _
                "You may have to allow this app to make changes to your device " & _
                "to perform this action.", vbCritical                                   '
        GoTo CleanUp                                                                    '
    End If
''
' ******************************************
' * Strip the unneeded stuff from the data *
' ******************************************
'
Proceed:
    AvailableWirelessNetworksData = Replace(Replace(Replace(AvailableWirelessNetworksData, _
            " ", ""), vbCrLf, ""), vbLf & vbLf, vbLf)                                   ' Remove all spaces,Line feeds, and the like from data in AvailableWirelessNetworksData
'
    NumberOfBSSIDs = (Len(AvailableWirelessNetworksData) - _
            Len(Replace(AvailableWirelessNetworksData, "BSSID", ""))) / Len("BSSID")    ' Count the number of BSSIDs in AvailableWirelessNetworksData
'
' ***********************************************
' * Initialize some variables that will be used *
' ***********************************************
'
    HeaderArray = Array("Network Adapter", "   SSID        ", "   Network Type        ", _
            "   Authorization Algorithm        ", "   Encryption        ", _
            "   MAC Address (BSSID)        ", "   Signal        ", "   Radio Type        ", _
            "   Band        ", "   Channel        ", "   RSSI        ", _
             "   Vendor        ")                                                       ' Establish Header names for the columns in the sheet
'
    ReDim ResultArray(1 To NumberOfBSSIDs, 1 To UBound(HeaderArray, 1) + 1)             ' Establish initial dimensions of the ResultArray
'
    ArrayRow = 0                                                                        ' Reset ArrayRow
    IncrementalEndPosition = 1                                                          ' Initialize IncrementalEndPosition value
'
' **********************************************************
' * Start saving the gathered WIFI data to our ResultArray *
' **********************************************************
'
    ResultArray(1, 1) = NetworkAdapterName                                              ' Save the name of the NetworkAdapter into ResultArray
'
    AvailableWirelessNetworksData = Mid$(AvailableWirelessNetworksData, _
            InStr(AvailableWirelessNetworksData, "SSID"))                               ' Find first SSID position
'
    Do While InStr(IncrementalEndPosition, AvailableWirelessNetworksData, "SSID") > 0
        ArrayRow = ArrayRow + 1                                                         '   Increment ArrayRow
'
' Save the SSID
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the SSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Networktype")                           '   Find the end character position of the SSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 2) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the SSID name into the ResultArray
'
        If ResultArray(ArrayRow, 2) = "" Then ResultArray(ArrayRow, 2) = "UnNamed"      '   If the saved SSID name = "" then set the SSID name to "UnNamed"
'
' Save the Networktype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Networktype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Networktype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Authentication")                        '   Find the end character position of the Networktype in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 3) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Networktype into the ResultArray
'
' Save the Authentication
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Authentication"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Authentication in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Encryption")                            '   Find the end character position of the Authentication in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 4) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Authentication into the ResultArray
'
' Save the Encryption
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Encryption"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Encryption in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "BSSID")                                 '   Find the end character position of the Encryption in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 5) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Encryption into the ResultArray
'
GetBSSIDdata:
' Save the MAC Address (BSSID)
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "BSSID"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the BSSID in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Signal")                                '   Find the end character position of the BSSID in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 6) = UCase(Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition))                                              '   Save the BSSID into the ResultArray
'
' Save the Signal level
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Signal"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Signal in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Radiotype")                             '   Find the end character position of the Signal in AvailableWirelessNetworksData
        ResultArray(ArrayRow, 7) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Signal into the ResultArray
'
' Save the Radiotype
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Radiotype"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Radiotype in AvailableWirelessNetworksData
        IncrementalEndPosition = InStr(IncrementalStartPosition, _
                AvailableWirelessNetworksData, "Band")                                  '   Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
        If IncrementalEndPosition = 0 Then                                              '   If 'Band' wasn't found then ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Radiotype in AvailableWirelessNetworksData
'
            BandNotFound = True                                                         '       Set BandNotFound flag = True
        End If
'
        ResultArray(ArrayRow, 8) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '       Save the Radiotype into the ResultArray
'
' Save the Band if found
        If BandNotFound Then                                                            '   If 'Band' wasn't found then do nothing in this section
        Else                                                                            '   Else ...
            IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                    AvailableWirelessNetworksData, "Band"), _
                    AvailableWirelessNetworksData, ":") + 1                             '       Find the start character position of the Band in AvailableWirelessNetworksData
'
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "Channel")                           '       Find the end character position of the Band in AvailableWirelessNetworksData
'
            ResultArray(ArrayRow, 9) = Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition, IncrementalEndPosition - _
                    IncrementalStartPosition)                                           '       Save the Band into the ResultArray
        End If
'
' Save the Channel & maybe calculated Band
        IncrementalStartPosition = InStr(InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "Channel"), _
                AvailableWirelessNetworksData, ":") + 1                                 '   Find the start character position of the Channel in AvailableWirelessNetworksData
'
        If InStr(IncrementalStartPosition, AvailableWirelessNetworksData, "H") > 0 Then '   If there is data after the Channel data that starts with "H" then ...
            IncrementalEndPosition = Application.Min(InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B"), InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "H"))                                '       Find the end character position of the Channel in AvailableWirelessNetworksData
        Else                                                                            '   Else ...
            IncrementalEndPosition = InStr(IncrementalStartPosition, _
                    AvailableWirelessNetworksData, "B")                                 '       Find the end character position of the Channel in AvailableWirelessNetworksData
        End If
'
        ResultArray(ArrayRow, 10) = Mid$(AvailableWirelessNetworksData, _
                IncrementalStartPosition, IncrementalEndPosition - _
                IncrementalStartPosition)                                               '   Save the Channel into the ResultArray
'
        If BandNotFound Then                                                            '   If the BSS data did not contain data for the 'Band' then ...
            If CInt(ResultArray(ArrayRow, 10)) < 15 Then                                '       If the integer value of the channel is lass than 15 then ...
                ResultArray(ArrayRow, 9) = "2.4GHZ"                                     '           Save "2.4GHZ" to the 'Band' column of ResultArray
            Else                                                                        '       Else ...
                ResultArray(ArrayRow, 9) = "5GHZ"                                       '           Save "5GHZ" to the 'Band' column of ResultArray
            End If
'
            BandNotFound = False                                                        '       Set BandNotFound flag back to False
        End If
'
' Save the Vendor
        If DisplayVendor Then                                                           '   If the User chose to get the vendors associated with the MAC Addresses then ...
            ResultArray(ArrayRow, 12) = GetRouterBrand(ResultArray(ArrayRow, 6), _
                    VendorDelay)                                                        '       Save the Vendor according to the Mac Address
'
            Application.StatusBar = Space(95) & "*** " & ArrayRow & " of " & NumberOfBSSIDs & _
                    " MAC Addresses have been processed ***"                            '       Update the StatusBar to inform the user of the progress
        End If
'
' **************************************************
' * Check for additional BSSID's for the same SSID *
' **************************************************
'
        IncrementalStartPosition = InStr(IncrementalEndPosition, _
                AvailableWirelessNetworksData, "SSID")                                  '   Check for additional BSSIDs
'
        If IncrementalStartPosition <> 0 Then                                           '   If another 'SSID' is found in AvailableWirelessNetworksData then ...
            If Mid$(AvailableWirelessNetworksData, _
                    IncrementalStartPosition - 1, 1) = "B" Then                         '       If the found 'SSID' in AvailableWirelessNetworksData is preceded by 'B" then
                ArrayRow = ArrayRow + 1                                                 '           Increment ArrayRow
'
                ResultArray(ArrayRow, 2) = ResultArray(ArrayRow - 1, 2)                 '           Save the previous SSID into the next row of ResultArray
                ResultArray(ArrayRow, 4) = ResultArray(ArrayRow - 1, 4)                 '           Save the previous Authorization into the next row of ResultArray
                ResultArray(ArrayRow, 5) = ResultArray(ArrayRow - 1, 5)                 '           Save the previous Encryption into the next row of ResultArray
                ResultArray(ArrayRow, 3) = ResultArray(ArrayRow - 1, 3)                 '           Save the previous Networktype into the next row of ResultArray
'
                GoTo GetBSSIDdata                                                       '           Jump to GetBSSIDdata
            End If
        End If
    Loop                                                                                ' Loop back
'
' ************************************************
' * Display the final results, format data, etc. *
' ************************************************
'
    For ResultArrayRow = 1 To UBound(ResultArray, 1)                                    ' Loop through the rows of ResultArray
        For ArrayRow = 1 To UBound(WLAN_BSS_ENTRY_Array, 1)                             '   Loop through the rows of WLAN_BSS_ENTRY_Array
            If UCase(WLAN_BSS_ENTRY_Array(ArrayRow, 1)) = _
                    UCase(ResultArray(ResultArrayRow, 6)) Then                          '       If we find a matching MAC Address then ...
                ResultArray(ResultArrayRow, 11) = WLAN_BSS_ENTRY_Array(ArrayRow, 2)     '           Save the corresponding RSSI value to ResultArray
            End If
        Next                                                                            '   Loop back
    Next                                                                                ' Loop back
'
    If ws Is Nothing Then Set ws = ActiveSheet                                          ' If no Display sheet was specified, set ws to the ActiveSheet
'
    With ws
        .Cells.Delete                                                                   '   Delete any previous results from the sheet
'
        With .Range("A1").Resize(, UBound(HeaderArray, 1) + 1)
            .Value2 = HeaderArray                                                       '       Display the HeaderArray to the sheet
            .HorizontalAlignment = xlCenter                                             '       Center the Headers horizontally in the cells
              .VerticalAlignment = xlCenter                                             '       Center the Headers vertically in the cells
                 .Font.FontStyle = "Bold"                                               '       Bold the Headers
        End With
'
        .Range("A2").Resize(UBound(ResultArray, 1), UBound(ResultArray, 2)) = ResultArray ' Display the ResultArray to the sheet
'
        If .AutoFilterMode Then .AutoFilterMode = False                                 '   If there is filtered data on the sheet then remove the filter
'
        With .Range(.Cells(1, 2), .Cells(.Rows.Count, .Cells(1, .Columns.Count).End(xlToLeft).Column))
            .Cells.Sort Key1:=.Columns(9), Order1:=xlAscending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to Channel Column J values lowest to highest
            .Cells.Sort Key1:=.Columns(10), Order1:=xlDescending, _
                    Orientation:=xlTopToBottom, Header:=xlYes                           '       Sort the data according to RSSI Column K values highest to lowest
            .AutoFilter                                                                 '       add AutoFilter option to the sheet
        End With
'
' Now we need to rearrange the columns on the sheet to the preferred order of the columns
'
        MyPreferredOrderOfColumnHeadersArray = Array(1, 2, 6, 9, 7, 11, 10, 8, 12, 4, 5, 3) '   Establish array of the order of columns you would like compared to current order
'
        .Range("A1").Resize(.Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, _
                UBound(MyPreferredOrderOfColumnHeadersArray) + 1) = Application.Index(.Cells, _
                Evaluate("ROW(1:" & .Cells.Find("*", , xlFormulas, , xlRows, _
                xlPrevious).Row & ")"), MyPreferredOrderOfColumnHeadersArray)           '       Rearrange the columns from current order to preferred order
'
        .Range("G2:G" & ArrayRow + 1).NumberFormat = "0"                                '   Format used cells in Column G as Whole numbers
        .Range("E2:E" & ArrayRow + 1).NumberFormat = "0%"                               '   Format used cells in Column E as percentages
        .Range("D2:G" & ArrayRow + 1).HorizontalAlignment = xlCenter                    '   Center the data in columns D:G horizontally in the cells
'
        .UsedRange.EntireColumn.AutoFit                                                 '   Autofit the used columns widths of the sheet
    End With
'
    MsgBox "Complete!"                                                                  '
'
CleanUp:
    WlanFreeMemory WirelessInterfaceList
    WlanFreeMemory BSS_Pointer_Address
    WlanCloseHandle lHandle, ByVal 0
    Application.StatusBar = False
End Sub


Function GetRouterBrand(ByVal MacAddr As String, Optional ByVal VendorDelay As Long = 1000) As String
'
    Dim WebSite             As String                                                   ' Variable to hold the URL of the website for MAC address lookup
    Dim XML_HTTP            As Object                                                   ' Object variable for making HTTP requests
'
    Sleep VendorDelay                                                                   ' Delay to ensure proper processing
'
' Construct the URL for MAC address lookup using the first 8 characters of the MAC address
    WebSite = "https://api.macvendors.com/" & Left$(MacAddr, 8)                         ' <--- Set this to the website to get data from
'
    Set XML_HTTP = CreateObject("MSXML2.XMLHTTP")                                       ' Create an instance of the XMLHTTP object
'
' Send an HTTP GET request to the website to retrieve the router brand information
    With XML_HTTP
        .Open "Get", WebSite, False                                                     '   Open a GET request to the specified URL
        .send                                                                           '   Send the request
    End With
'
    If XML_HTTP.responsetext = "{""errors"":{""detail"":""Not Found""}}" Then           ' If the Vendor was not found then ...
        GetRouterBrand = "Vendor Not Found"                                             '   Return "Vendor Not Found" if vendor information is not available
    Else                                                                                ' Else ...
        GetRouterBrand = XML_HTTP.responsetext                                          '   Return the router brand information received from the website
    End If
End Function


Function Get_BSSID_Data(Optional ByVal Admin As Boolean) As String                      ' Compliments of Jaafar Tribak
'
' The purpose of this function is to retrieve BSSID (Basic Service Set Identifier) data using a temporary VBScript file.
'
    Dim sTempTextFile   As String
    Dim TEMP_VBS_FILE   As Variant
    Dim ObjFile         As Object
    Dim objFSO          As Object
    Dim ObjShell        As Object
'
    TEMP_VBS_FILE = Environ("TEMP") & "\BSSID.vbs"                                      ' Set the path for the temporary VBScript file using the TEMP environment variable
'
    Call CreateTempVBS(TEMP_VBS_FILE)                                                   ' Call the CreateTempVBS function to create the temporary VBScript file
'
    sTempTextFile = Replace(TEMP_VBS_FILE, ".vbs", ".txt")                              ' Replace the file extension in the temporary file path to create a temporary text file path
'
    Set ObjShell = CreateObject("Shell.Application")                                    ' Create a Shell.Application object
    ObjShell.ShellExecute "cscript", TEMP_VBS_FILE, "", IIf(Admin, "runas", ""), 0&     ' Execute the temporary VBScript file using cscript
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")                             ' Create a FileSystemObject (objFSO) to handle file operations
'
    With objFSO
        Set ObjFile = .CreateTextFile(sTempTextFile, True)                              '   Create sTempTextFile with write access at the temporary text file path
        Set ObjFile = .OpenTextFile(sTempTextFile, 1&)                                  '   Open sTempTextFile for reading at the temporary text file path
'
        Call Sleep(1000)                                                                '   Pause execution for 1000 milliseconds (1 second) using the Sleep API function
'
        If Not ObjFile.AtEndOfStream Then Get_BSSID_Data = ObjFile.ReadAll              '   If the text file hasn't reached end of stream, save all data into Get_BSSID_Data
'
        ObjFile.Close                                                                   '   Close sTempTextFile
'
        .DeleteFile sTempTextFile                                                       '   Delete sTempTextFile
        .DeleteFile TEMP_VBS_FILE                                                       '   Delete TEMP_VBS_FILE
    End With
End Function


Sub CreateTempVBS(ByVal FilePathName As String)                                         ' Compliments of Jaafar Tribak
    Dim sVBSCode As String
    Dim objFSO As Object, ObjFile As Object
 
    sVBSCode = "Set ObjShell = CreateObject(""Wscript.Shell"")" & vbCrLf
    sVBSCode = sVBSCode & "strCommand =""netsh wlan show network mode=bssid""" & vbCrLf
    sVBSCode = sVBSCode & "Set objExecObject = ObjShell.Exec(strCommand)" & vbCrLf
    sVBSCode = sVBSCode & "Do While Not objExecObject.StdOut.AtEndOfStream" & vbCrLf
    sVBSCode = sVBSCode & "strText = objExecObject.StdOut.ReadAll()" & vbCrLf
    sVBSCode = sVBSCode & "Loop" & vbCrLf
    sVBSCode = sVBSCode & "ResultFile =" & Chr(34) & _
               Replace(FilePathName, ".vbs", ".txt") & Chr(34) & vbCrLf
    sVBSCode = sVBSCode & "Set objFSO = CreateObject(""Scripting.FileSystemObject"")" & vbCrLf
    sVBSCode = sVBSCode & "Set ObjFile = objFSO.CreateTextFile(""" & _
               Replace(FilePathName, ".vbs", ".txt") & """, True)" & vbCrLf
    sVBSCode = sVBSCode & "objFile.Close" & vbCrLf
    sVBSCode = sVBSCode & "Set objFile = objFSO.OpenTextFile(ResultFile, 2)" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Write strText" & vbCrLf
    sVBSCode = sVBSCode & "ObjFile.Close"
'
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ObjFile = objFSO.CreateTextFile(FilePathName, True)
    ObjFile.Close
'
    Set ObjFile = objFSO.OpenTextFile(FilePathName, 2&)
    ObjFile.Write sVBSCode
    ObjFile.Close
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,077
Messages
6,122,992
Members
449,094
Latest member
masterms

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top