'
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) = 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, 2) = 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
ResultArray(ArrayRow, 5) = Mid$(AvailableWirelessNetworksData, IncrementalStartPosition, _
IncrementalEndPosition - IncrementalStartPosition) ' Save the Radiotype into the ResultArray
'
' Save the Band
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, 3) = Mid$(AvailableWirelessNetworksData, IncrementalStartPosition, _
IncrementalEndPosition - IncrementalStartPosition) ' Save the Band into the ResultArray
'
' Save the Channel
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, 4) = Mid$(AvailableWirelessNetworksData, IncrementalStartPosition, _
IncrementalEndPosition - IncrementalStartPosition) ' Save the Channel into the ResultArray
'
' **************************************************
' * 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, 1) = ResultArray(ArrayRow - 1, 1) ' Save the previous SSID into the next row of ResultArray
ResultArray(ArrayRow, 7) = ResultArray(ArrayRow - 1, 7) ' Save the previous Authorization into the next row of ResultArray
ResultArray(ArrayRow, 8) = ResultArray(ArrayRow - 1, 8) ' Save the previous Encryption into the next row of ResultArray
ResultArray(ArrayRow, 9) = ResultArray(ArrayRow - 1, 9) ' 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. *
' ************************************************
'
ResultArray = ReDimPreserve(ResultArray, ArrayRow, UBound(HeaderArray, 1) + 1) ' Delete any unneeded rows in the ResultArray
'
With ws
.Cells(1, "A").Resize(.Cells(.Rows.Count, "A").End(xlUp).Row, _
UBound(HeaderArray, 1) + 1).ClearContents ' Clear previous results from 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
'
.Range("B2:E" & ArrayRow + 1).HorizontalAlignment = xlCenter ' Center the data in columns B:E horizontally in the cells
'
.UsedRange.EntireColumn.AutoFit ' Autofit the used columns widths of the sheet
'
If .AutoFilterMode Then .AutoFilterMode = False ' If there is filtered data on the sheet then remove the filter
'
With .Cells(1, 1).CurrentRegion
.Cells.Sort Key1:=.Columns(2), Order1:=xlDescending, _
Orientation:=xlTopToBottom, Header:=xlYes ' Sort the data according to Signal Column B values highest to lowest
.AutoFilter ' add AutoFilter option to the sheet
End With
End With
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
Bookmarks