Access关闭时重复触发Mainfrm加载弹窗异常排查

关闭数据库时再次弹出Mainfrm的Form_Load通知，是Access窗体关闭流程的固有特性导致：Mainfrm作为主窗体，Load事件中以隐藏模式打开了kikThemOut轮询窗体，执行Application.Quit时Access会按窗体打开的逆序销毁对象，先关隐藏的kikThemOut再关主窗体；硬退出过程中如果触发主窗体的重绘、窗体集合刷新，就会误触发Form_Load事件重跑弹窗逻辑。
现有代码的两个写法会放大这个异常：

• kikThemOut的计时器在退出流程中没有被禁用，退出过程中仍会触发轮询逻辑
• fGetOut函数直接调用Application.Quit硬退出，没有提前清理已打开的窗体、报表对象，容易触发Access的异常状态重置

1. 新增全局退出标记，拦截非启动阶段的Load逻辑 #

在GetOutMod模块顶部新增全局布尔变量标记退出状态，同时修改fGetOut函数，退出前先清理对象、关闭轮询窗体：

Option Compare Database
Option Explicit
' 全局退出状态标记
Public gbIsAppQuitting As Boolean

Function fGetOut() As Integer
Dim RetVal As Integer
Dim db As DAO.Database
Dim rst As Recordset
Dim frm As AccessObject, rpt As AccessObject
On Error GoTo Err_fGGO

' 标记正在退出
gbIsAppQuitting = True
' 先关闭轮询窗体，避免计时器重复触发
If CurrentProject.AllForms("kikThemOut").IsLoaded Then
    DoCmd.Close acForm, "kikThemOut", acSaveNo
End If

Set db = DBEngine.Workspaces(0).Databases(0)
Set rst = db.OpenRecordset("KickEmOff", dbOpenSnapshot)
If rst.EOF And rst.BOF Then
 RetVal = True
 GoTo Exit_fGGO
Else
 If DCount("*", "KickEmOff", "GetOut=1") > 0 Then
      ' 先关闭所有非主窗体、已打开的报表，避免退出时触发对象重载
      For Each frm In CurrentProject.AllForms
        If frm.IsLoaded And frm.Name <> "Mainfrm" Then
          DoCmd.Close acForm, frm.Name, acSaveNo
        End If
      Next
      For Each rpt In CurrentProject.AllReports
        If rpt.IsLoaded Then
          DoCmd.Close acReport, rpt.Name, acSaveNo
        End If
      Next
      ' 不保存任何对象更改直接退出
      Application.Quit acQuitSaveNone
 Else
  RetVal = True
  ' 未触发退出则重置标记
  gbIsAppQuitting = False
 End If
End If
Exit_fGGO:
 fGetOut = RetVal
 If Not rst Is Nothing Then
    rst.Close
    Set rst = Nothing
 End If
 Set db = Nothing
 Exit Function
Err_fGGO:
 Resume Next
End Function

2. 修改Mainfrm的Form_Load逻辑，加状态拦截 #

在Mainfrm的Load事件最开头加判断，退出流程触发的重载直接跳过所有业务逻辑：

Private Sub Form_Load()
' 退出流程触发的重载直接拦截
If gbIsAppQuitting = True Then
    Exit Sub
End If

' 通知弹窗逻辑
Dim trs As Recordset
Set trs = CurrentDb.OpenRecordset("Y22_CurrMonth")
If trs.EOF = False Then
    Dim tMsg, tStyle, tTitle, tHelp, tCtxt, tResponse, tMyString
    tMsg = "There are Notifications Due, Do you want to view them?"
    tStyle = vbYesNo + vbExclamation + vbDefaultButton2
    tTitle = "Notifications Alert"
    tHelp = "DEMO.HLP"
    tCtxt = 1000
    tResponse = MsgBox(tMsg, tStyle, tTitle, tHelp, tCtxt)
    If tResponse = vbYes Then
        DoCmd.OpenReport "Notifications Current Month", acViewReport, acWindowNormal
    Else
        tMyString = "No"
    End If
End If
trs.Close
Set trs = Nothing

' 加载隐藏轮询窗体
DoCmd.OpenForm "kikThemOut", , , , , acHidden
End Sub

3. 修改kikThemOut窗体代码，退出前停用计时器 #

在轮询逻辑触发退出前先把计时器间隔设为0，避免退出过程中重复触发Timer事件：

Private Sub Form_Timer()
If DCount("*", "KickEmOff", "GetOut=1") > 0 Then
     ' 先停计时器防止重复触发
     Me.TimerInterval = 0
     Set TaskDialogAC = New cTaskDialog
    With TaskDialogAC
        .Init
        .MainInstruction = "Dashboard Maintenance"
        .Flags = TDF_CALLBACK_TIMER
        .Content = "The Dashboard will be closed after 20 seconds for maintenance"
        .CommonButtons = TDCBF_CLOSE_BUTTON
        .IconMain = IDI_WINLOGO
        .Footer = "Closing in 20 seconds..."
        .Title = "Dashboard Maintenance"
        .AutocloseTime = 20
        .ParenthWnd = Me.hwnd
        .ShowDialog
    End With
    Call fGetOut
Else
    DoCmd.Requery
End If
End Sub

• 原逻辑用DSum("GetOut", "KickEmOff") = "1"判断踢人标记存在逻辑漏洞：如果表内有多条GetOut=1的记录，DSum结果会大于1，判断直接失效，替换为DCount("*", "KickEmOff", "GetOut=1") > 0更严谨
• 所有DAO Recordset对象用完要手动关闭、释放引用，避免多用户场景下出现锁库问题
• kikThemOut的轮询间隔建议调整为10秒以上，5秒一次的高频轮询会增加accdb文件的锁冲突概率

内容的提问来源于stack exchange，提问作者user2947398