RonPaii
Active member
- Local time
- Today, 08:51
- Joined
- Jul 16, 2025
- Messages
- 143
It's setup as a callback which raises an evert on my main form of the change. You don't need any timer and the main form would know how to shut down the other forms and/or the FE. BTW if you are seeing drops on a wired network, there is a hardware problem that needs to be fixed. I don't allow connections from WIFI or WAN.I stated earlier that you could close the form and re-open - IF the connection has by that time re-established itself. Which is a possibility. The related question "DOES ACCESS STILL NEED TO WAIT" can only be answered by testing the connection to see if you have one. (See @RonPaii remark regarding WMI). If you have a connection but the previously open form has now gone bonkers, try to close it and find out. That comes back to whether the form is still around or whether it will respond to a DoCmd.Close of the form, or whatever other method you try.
The real headache in this question is whether Access itself has actually EXITED because of the lost connection between the FE and the linked tables in the BE. That is going to depend on factors such as the way the network was set up and whether the App's error handling (provided by the app's author) intercepted the error that would possibly be fatal to Access itself. I have seen cases where Access died because it lost contact with a linked BE table. Therefore, in answer to the "NEED TO WAIT" question, I have to reply, "Damned if I know. It depends on too many factors."
This presumes that Access is able to deal with that. Remember that Access is (a) single-threaded for code execution and (b) your code is not always in control if no relevant event has been recently triggered. This implies timer operations, and the problem there is that a complex timer routine is going to slow you down a lot. A MAIN program clearly could set up event interceptors to tell you what is going on, but you don't control all of the event vectors for MSACCESS.EXE, the MAIN program. That kind of hampers the detection process.
Code:
'Class ClassWMI header'
Private oWMI_root_WMI As SWbemServicesEx ' Service Object "\root\WMI"
Private WithEvents oSinkDisconnect As SWbemSink ' Disconnect Event object
Private WithEvents oSinkConnect As SWbemSink ' Connect Event object
Public Event Changed(strChanged As String) ' Raised when NIC changes
Private m_bMonitor As Boolean ' True if network monitor is active
'Setup callback called by class init'
Private Sub WMI_MontiorNetwork()
On Error GoTo errWMI_MontiorNetwork
Set oWMI_root_WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\WMI")
Set oSinkDisconnect = New SWbemSink
Set oSinkConnect = New SWbemSink
oWMI_root_WMI.ExecNotificationQueryAsync oSinkDisconnect, "SELECT * FROM MSNdis_StatusMediaDisconnect"
oWMI_root_WMI.ExecNotificationQueryAsync oSinkConnect, "SELECT * FROM MSNdis_StatusMediaConnect"
m_bMonitor = True
doneWMI_MontiorNetwork:
Exit Sub
errWMI_MontiorNetwork:
m_bMonitor = False
'Me.WriteLog MODULENAME & ".WMI_MonitorNetwork", "Could not setup monitor. Error:( " & Err.Number & " ) " & Err.Description
Resume doneWMI_MontiorNetwork
End Sub
'--------------------
' Shut-down network monitor on program close
Private Sub Class_Terminate()
On Error Resume Next
If Not oSinkDisconnect Is Nothing Then
oSinkDisconnect.Cancel
Set oSinkDisconnect = Nothing
End If
If Not oSinkConnect Is Nothing Then
oSinkConnect.Cancel
Set oSinkConnect = Nothing
End If
m_bMonitor = False
If Not oWMI_root_WMI Is Nothing Then Set oWMI_root_WMI = Nothing
End Sub
'-----------------
' SWbemSink Event on disconnect of a NIC
Private Sub oSinkDisconnect_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, _
ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
On Error Resume Next
Dim strNic As String
Dim iNIC As Integer
strNic = objWbemObject.Path_.RelPath
' Refill the NIC arrays
'WMI_Fill_Nic
' Strip down to only name of NIC
' ex. MSNdis_StatusMediaDisconnect.InstanceName="Realtek PCIe GBE Family Controller"
iNIC = InStr(1, strNic, "=")
If iNIC > 1 Then
strNic = Mid(strNic, iNIC + 2)
strNic = left(strNic, Len(strNic) - 1)
End If
' Let form know something changed
RaiseEvent Changed(strNic & ", has Disconnected")
End Sub
'-----------------
' SWbemSink Event on Connection of a NIC
'
Private Sub oSinkConnect_OnObjectReady(ByVal objWbemObject As WbemScripting.ISWbemObject, _
ByVal objWbemAsyncContext As WbemScripting.ISWbemNamedValueSet)
On Error Resume Next
Dim strNic As String
Dim iNIC As Integer
strNic = objWbemObject.Path_.RelPath
' Refill the NIC arrays
'WMI_Fill_Nic
' Strip down to only name of NIC
' ex. MSNdis_StatusMediaDisconnect.InstanceName="Realtek PCIe GBE Family Controller"
iNIC = InStr(1, strNic, "=")
If iNIC > 1 Then
strNic = Mid(strNic, iNIC + 2)
strNic = left(strNic, Len(strNic) - 1)
End If
' Let form know something changed
RaiseEvent Changed(strNic & ", has connected")
End Sub
'Main Form ---- Always open'
Private WithEvents oWMI As ClassWMI ' Check Network status Handles ClassWMI events
'-------------------------------
' Handle Changed event when WMI see a network change
' Check status of network change on ClassWMI Changed event
' Shut down application on WIFI, VPN or no Network
Private Sub oWMI_Changed(whatChanged As String)
MsgBox whatChanged & vbCrLf & _
"No network connections, found." & vbCrLf & vbCrLf & _
"Closing the application.", _
vbCritical, "No Active Connections"
End Sub