ACCESS VBA - Obtain Wireless Network Name (Connected) - vba

Question

Is it possible to detect the users Wifi network (SSID) they are connected to via vba? in Access 2010
Many thanks
Max

Answer 1

After some more research, I found the following link: http://www.vbforums.com/showthread.php?547916-List-available-wireless-networks-(using-WMI)-Help-pls
If you scroll down to post #19 there is a code fragment using Native Wifi API, I adapted to the following code fragment where Function GetConnectedSSID() will return the SSID of the currently connected Wifi network:
Option Explicit
Private Const DOT11_SSID_MAX_LENGTH As Long = 32
Private Const WLAN_MAX_PHY_TYPE_NUMBER As Long = 8
Private Const WLAN_AVAILABLE_NETWORK_CONNECTED As Long = 1
Private Const WLAN_AVAILABLE_NETWORK_HAS_PROFILE As Long = 2
Private Type GUID
data1 As Long
data2 As Integer
data3 As Integer
data4(7) As Byte
End Type
Private Type WLAN_INTERFACE_INFO
ifGuid As GUID
InterfaceDescription(255) As Byte
IsState As Long
End Type
Private Type DOT11_SSID
uSSIDLength As Long
ucSSID(DOT11_SSID_MAX_LENGTH - 1) As Byte
End Type
Private Type WLAN_AVAILABLE_NETWORK
strProfileName(511) As Byte
dot11Ssid As DOT11_SSID
dot11BssType As Long
uNumberOfBssids As Long
bNetworkConnectable As Long
wlanNotConnectableReason As Long
uNumberOfPhyTypes As Long
dot11PhyTypes(WLAN_MAX_PHY_TYPE_NUMBER - 1) As Long
bMorePhyTypes As Long
wlanSignalQuality As Long
bSEcurityEnabled As Long
dot11DefaultAuthAlgorithm As Long
dot11DefaultCipherAlgorithm As Long
dwflags As Long
dwreserved As Long
End Type
Private Type WLAN_INTERFACE_INFO_LIST
dwNumberOfItems As Long
dwIndex As Long
InterfaceInfo As WLAN_INTERFACE_INFO
End Type
Private Type WLAN_AVAILABLE_NETWORK_LIST
dwNumberOfItems As Long
dwIndex As Long
Network As WLAN_AVAILABLE_NETWORK
End Type
Private Declare Function WlanOpenHandle Lib "wlanapi.dll" (ByVal dwClientVersion As Long, _
ByVal pdwReserved As Long, _
ByRef pdwNegotiaitedVersion As Long, _
ByRef phClientHandle As Long) As Long
Private Declare Function WlanEnumInterfaces Lib "wlanapi.dll" (ByVal hClientHandle As Long, _
ByVal pReserved As Long, _
ppInterfaceList As Long) As Long
Private Declare Function WlanGetAvailableNetworkList Lib "wlanapi.dll" (ByVal hClientHandle As Long, _
pInterfaceGuid As GUID, _
ByVal dwflags As Long, _
ByVal pReserved As Long, _
ppAvailableNetworkList As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Declare Sub WlanFreeMemory Lib "wlanapi.dll" (ByVal pMemory As Long)
Public Function GetConectedSSID() As String
Dim lngReturn As Long
Dim lngHandle As Long
Dim lngVersion As Long
Dim lngList As Long
Dim lngAvailable As Long
Dim lngStart As Long
Dim intCount As Integer
Dim strSSID As String
Dim strProfile As String
Dim udtList As WLAN_INTERFACE_INFO_LIST
Dim udtAvailableList As WLAN_AVAILABLE_NETWORK_LIST
Dim udtNetwork As WLAN_AVAILABLE_NETWORK
'
' Get a Handle
'
lngReturn = WlanOpenHandle(2&, 0&, lngVersion, lngHandle)
If lngReturn = 0 Then
'
' Enumerate the Interfaces
' (Note: this code only looks at the first interface)
'
lngReturn = WlanEnumInterfaces(ByVal lngHandle, 0&, lngList)
CopyMemory udtList, ByVal lngList, Len(udtList)
'
' Get the list of available Networks
'
lngReturn = WlanGetAvailableNetworkList(lngHandle, udtList.InterfaceInfo.ifGuid, 2&, 0&, lngAvailable)
CopyMemory udtAvailableList, ByVal lngAvailable, LenB(udtAvailableList)
intCount = 0
lngStart = lngAvailable + 8
Do
'
' Populate the Available network structure
'
CopyMemory udtNetwork, ByVal lngStart, Len(udtNetwork)
'
' Display the Data for this Network
'
strProfile = ByteToString(udtNetwork.strProfileName)
strProfile = Left$(strProfile, InStr(strProfile, Chr(0)) - 1)
strSSID = ByteToString(udtNetwork.dot11Ssid.ucSSID, udtNetwork.dot11Ssid.uSSIDLength, False)
strSSID = Left(strSSID, InStr(strSSID, Chr(0)) - 1)
If (udtNetwork.dwflags And WLAN_AVAILABLE_NETWORK_CONNECTED) = WLAN_AVAILABLE_NETWORK_CONNECTED Then
'Debug.Print "Profile "; strProfile, "SSID "; strSSID, "Connected "; udtNetwork.dwflags
GetConectedSSID = strSSID
End If
intCount = intCount + 1
lngStart = lngStart + Len(udtNetwork)
'
' Process all available networks
'
Loop Until intCount = udtAvailableList.dwNumberOfItems
WlanFreeMemory lngAvailable
WlanFreeMemory lngList
End If
End Function
Private Function ByteToString(bytArray() As Byte, Optional lngLen As Long = 0, Optional boConvert As Boolean = True) As String
Dim strTemp As String
Dim intI As Integer
Dim intEnd As Integer
If lngLen = 0 Then
intEnd = UBound(bytArray)
Else
intEnd = lngLen
End If
For intI = 0 To intEnd
strTemp = strTemp & Chr(bytArray(intI))
Next intI
If boConvert = True Then strTemp = StrConv(strTemp, vbFromUnicode)
ByteToString = strTemp
End Function