locked
Check for Wi-Fi Connection RRS feed

  • Question

  • Hello.

    I have a MS Access 2016 db on a Win10 machine. I want to discourage user from using a Wi-Fi connection when using this database. I found the following code below, but I cannot get it to work. I'm testing it on a Win10 machine utilizing a Wi-Fi connection. But I cannot get the message to pop-up. I setup a AutoExec macro that calls the NetworkConnection function.

    Please let me know how I can get this to work.

    Cheers, Kevin

    Function NetworkConnection()
        If IsConnectedbyWireless = True Then
            MsgBox "Connect to network via ethernet. Do not use Wi-Fi.", vbOKOnly, "Network Connection"
        End If
    
    End Function
    
    '---------------------------------------------------------------------------------------
    ' Procedure : IsConnectedbyWireless
    ' Author    : Daniel Pineault, CARDA Consultants Inc.
    ' Website   : http://www.cardaconsultants.com
    ' Purpose   : Determine whether or not the PC is currectly connected using a wireless
    '             connection
    '               True -> has an active wireless connection
    '               False -> does not have an active wireless connection
    ' Copyright : The following is release as Attribution-ShareAlike 4.0 International
    '             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
    ' Req'd Refs: Uses Late Binding, so none required
    '
    ' Input Variables:
    ' ~~~~~~~~~~~~~~~~
    ' None
    '
    ' Usage:
    ' ~~~~~~
    ' ? IsConnectedbyWireless
    '
    '
    ' Revision History:
    ' Rev       Date(yyyy/mm/dd)        Description
    ' **************************************************************************************
    ' 1         2017-01-29              Initial Release
    ' 2         2017-07-11              Added the use of the GetWirelessNames()
    ' 3         2018-09-20              Updated Copyright
    '---------------------------------------------------------------------------------------
    Public Function IsConnectedbyWireless() As Boolean
        'Ref: https://msdn.microsoft.com/en-us/library/aa394216%28v=vs.85%29.aspx?f=255&MSPPError=-2147217396
        Dim oWMI                  As Object
        Dim oWirelessAdapters     As Object
        Dim WirelessNames          As Collection
        Dim i                     As Long
     
        On Error GoTo Error_Handler
     
        Set WirelessNames = GetWirelessNames()
        Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
        For i = 1 To WirelessNames.Count
            Set oWirelessAdapters = oWMI.ExecQuery("SELECT *" & vbCrLf & _
                                                   " FROM Win32_NetworkAdapter" & vbCrLf & _
                                                   " WHERE NetconnectionID = '" & WirelessNames(i) & "'" & _
                                                   "       AND (NetConnectionStatus=1 OR NetConnectionStatus=2)" & _
                                                   "       AND PhysicalAdapter='True'")
            If oWirelessAdapters.Count <> 0 Then IsConnectedbyWireless = True
        Next i
     
    Error_Handler_Exit:
        On Error Resume Next
        Set WirelessNames = Nothing
        Set oWirelessAdapters = Nothing
        Set oWMI = Nothing
        Exit Function
     
    Error_Handler:
        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: IsConnectedbyWireless" & vbCrLf & _
               "Error Description: " & Err.Description & _
               Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
               , vbOKOnly + vbCritical, "An Error has Occurred!"
        Resume Error_Handler_Exit
    End Function
     
    '---------------------------------------------------------------------------------------
    ' Procedure : GetWirelessNames
    ' Original Author : Mohammed Alyafae, 9/12/2011
    ' Source    : https://gallery.technet.microsoft.com/scriptcenter/Disable-wireless-f3bcf66f#content
    ' Modified by : Daniel Pineault, CARDA Consultants Inc.
    '             The original version only returned the first wireless adapter, this
    '             script returns a script of all the wireless adapters.
    ' Website   : http://www.cardaconsultants.com
    ' Purpose   : Build a collection of wireless network connections
    '               *** Is used by IsConnectedbyWireless
    ' Copyright : The following is release as Attribution-ShareAlike 4.0 International
    '             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
    ' Req'd Refs: Uses Late Binding, so none required
    '
    ' Input Variables:
    ' ~~~~~~~~~~~~~~~~
    ' None
    '
    ' Revision History:
    ' Rev       Date(yyyy/mm/dd)        Description
    ' **************************************************************************************
    ' 1         2017-07-11              Initial Release
    ' 2         2018-09-20              Updated Copyright
    '---------------------------------------------------------------------------------------
    Function GetWirelessNames() As Collection
        Dim strKeyPath            As String
        Dim strComputer           As String
        Dim objReg                As Object
        Dim arrSubKeys
        Dim SubKey
        Dim strValueName          As String
        Dim dwValue
        Dim strValue              As String
        Const HKLM = &H80000002
        Dim WirelessNames          As Collection
     
        Set WirelessNames = New Collection
     
        strKeyPath = "SYSTEM\CurrentControlSet\Control\Network\{4D36E972-E325-11CE-BFC1-08002BE10318}"
        strComputer = "."
     
        Set objReg = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
        objReg.Enumkey HKLM, strKeyPath, arrSubKeys
     
        For Each SubKey In arrSubKeys
            strValueName = "MediaSubType"
            objReg.GetDWORDValue HKLM, strKeyPath & "\" & SubKey & "\" & "Connection", strValueName, dwValue
            If dwValue = 2 Then
                strValueName = "Name"
                objReg.GetStringValue HKLM, strKeyPath & "\" & SubKey & "\" & "Connection", strValueName, strValue
                WirelessNames.Add strValue
                '            Exit For
            End If
        Next
     
        Set GetWirelessNames = WirelessNames
        Set WirelessNames = Nothing
        Set objReg = Nothing
    End Function

    Thursday, June 18, 2020 5:35 PM

Answers

All replies

  • I believe that Daniel's code only checks that a WiFi connection exists … NOT that it is actually in use.

    Recommend you look at this thread at Utter Access for code that checks whether Wifi is actually being used: Prevent Form From Opening When WiFi is in use. Its a long thread and the 'final' working code is in post #37

    Thursday, June 18, 2020 6:06 PM
  • Hi isladogs52,

    Thanks for the advise. I tried the codes listed in UA with no luck. Please let me know if you or anyone else has any suggestions.

    Cheers, Kevin

    BTW, your link goes to your company instead of the UA article.

    Thursday, June 18, 2020 7:17 PM
  • Oops. Sorry about that.

    The correct link is https://www.utteraccess.com/forum/index.php?s=&showtopic=2058223&view=findpost&p=2754566

    As stated the final code is in post #37.

    If you have already tried that code unsuccessfully, please can you provide details of any issues/errors you experienced as I'm Intending to publish that code on my website in the next few days (with the consent of @adezii who started that code approach 

    • Marked as answer by KevinATF Thursday, June 18, 2020 9:09 PM
    Thursday, June 18, 2020 8:21 PM
  • My apologies. I don't visit UA very much and didn't navigate to the page where post 37 resides. That suggestion did the trick! Many thanks.

    Cheers, Kevin

    Thursday, June 18, 2020 9:11 PM
  • Excellent.

    If it works for you, please click the Propose As Answer link

    Thursday, June 18, 2020 9:47 PM