Option Explicit
'
#If VBA7 Then
Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare PtrSafe Function CloseClipboard Lib "user32" () As LongPtr
Declare PtrSafe Function EmptyClipboard Lib "user32" () As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)
#Else
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
#End If
'
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Sub GetAvailableWifiNetworksInfo()
'
Dim ArrayRow As Long
Dim IncrementalEndPosition As Long, IncrementalStartPosition As Long
Dim AvailableWirelessNetworksData As String
Dim TimeToAllowWifiNetworksToRefresh As String
Dim HeaderArray As Variant, ResultArray() As Variant
Dim ws As Worksheet
'
Set ws = Sheets("Sheet1") ' <--- Set this to the name of the sheet to diplay the results to
'
' *************************
' * Refresh the WIFI list *
' *************************
'
TimeToAllowWifiNetworksToRefresh = "0:00:05" ' <--- Set this to the amount of time to allow Wifi Networks To Refresh
'
With CreateObject("WScript.Shell")
.Run "%windir%\explorer.exe ms-availablenetworks:" ' refresh the wifi list
End With
'
Application.Wait (Now + TimeValue(TimeToAllowWifiNetworksToRefresh)) ' Delay script for a certain amount of time
'
SetCursorPos 400, 400: mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0 ' Simulate a mouse click to remove the wifi list window
'
' **********************************************
' * Gather the available WIFI connections data *
' **********************************************
'
CreateObject("WScript.Shell").Run "cmd /c netsh wlan show networks mode=BSSID" & _
"|clip""", 0, True ' Save results of the cmdline to the clipboard
'
With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.GetFromClipboard ' get cmdline output from clipboard
AvailableWirelessNetworksData = .GetText(1) ' Save the clipboard contents to AvailableWirelessNetworksData
End With
'
OpenClipboard (0&): EmptyClipboard: CloseClipboard ' Erase the contents that were saved to the clipboard
'
' ******************************************
' * 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
'
' ***********************************************
' * Initialize some variables that will be used *
' ***********************************************
'
HeaderArray = Array("SSID", " Signal ", " Band ", " Channel ", _
" Radio Type ", " Mac Address (BSSID) ", _
" Authorization Algorithm ", " Encryption ", _
" Network Type ") ' Establish Header names for the columns in the sheet
'
ReDim ResultArray(1 To 1000, 1 To UBound(HeaderArray, 1) + 1) ' Establish initial dimensions of the ResultArray, we can fix them later, if need be
'
IncrementalEndPosition = 1 ' Initialize IncrementalEndPosition value
'
' **********************************************************
' * Start saving the gathered WIFI data to our 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, 1) = Mid$(AvailableWirelessNetworksData, IncrementalStartPosition, _
IncrementalEndPosition - IncrementalStartPosition) ' Save the SSID name into the ResultArray
'
If ResultArray(ArrayRow, 1) = "" Then ResultArray(ArrayRow, 1) = "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, 9) = 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, 7) = 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, 8) = Mid$(AvailableWirelessNetworksData, IncrementalStartPosition, _
IncrementalEndPosition - IncrementalStartPosition) ' Save the Encryption into the ResultArray
Bookmarks