MS Access 2016会话日志查询获取最新日期及当前会话激活问题

问题背景 #

开发的MS Access 2016多用户数据库用于跟踪销售报价、订单、工程订单及发货流程，登录表单需为不同用户组分配特定权限，但当前系统调用的活跃用户会话并非最新会话，而是上一次的会话记录。现有tbl12SessionLog表记录会话信息，登录及操作时由公共函数填充，相关SQL查询与VBA代码如下：

现有代码 #

SQL查询（获取会话信息） #

SELECT 
    tbl12SessionLog.EmployeeID, tbl12SessionLog.EmployeeName, 
    MAX(tbl12SessionLog.SessionID) AS MaxOfSessionID, 
    tbl12SessionLog.SessionActivity, 
    MAX(tbl12SessionLog.TimeStamp) AS MaxOfTimeStamp,   
    tbl11Employee.Initials, qry01EmployeeAccess.PrivilegeID, 
    qry01EmployeeAccess.Privilege, qry01EmployeeAccess.FirstName
FROM 
    (tbl11Employee 
INNER JOIN 
    tbl12SessionLog ON tbl11Employee.EmployeeID = tbl12SessionLog.EmployeeID) 
INNER JOIN 
    qry01EmployeeAccess ON tbl11Employee.EmployeeID = qry01EmployeeAccess.EmployeeID
GROUP BY 
    tbl12SessionLog.EmployeeID, tbl12SessionLog.EmployeeName, 
    tbl12SessionLog.SessionActivity, tbl11Employee.Initials, 
    qry01EmployeeAccess.PrivilegeID, qry01EmployeeAccess.Privilege, 
    qry01EmployeeAccess.FirstName
HAVING 
    (((tbl12SessionLog.EmployeeID) = [TempVars]![CurrentUserID]) 
      AND ((tbl12SessionLog.SessionActivity) = "Log On"))
ORDER BY 
    MAX(tbl12SessionLog.TimeStamp) DESC;

VBA会话记录函数 #

Public Sub Session(SessionActivity As String)
 
    CurrentDb.Execute "INSERT INTO tbl12SessionLog (EmployeeName, SessionActivity) Values _ 
       ('" & TempVars("UserName").Value & "', '" & SessionActivity & "')"
    CurrentDb.Execute "UPDATE qry11EmployeeExtended INNER JOIN tbl12SessionLog ON  _ 
       qry11EmployeeExtended.EmployeeName = tbl12SessionLog.EmployeeName SET _ 
       tbl12SessionLog.EmployeeID = [qry11EmployeeExtended]![EmployeeID]"

End Sub

可行解决方案 #

1. 修正会话记录函数，确保登录会话唯一性 #

现有VBA函数先插入记录再更新EmployeeID，易导致多用户场景下关联错误，且未明确绑定当前登录的唯一会话。修改为：

Public Sub Session(SessionActivity As String)
    Dim rs As DAO.Recordset
    Dim currentEmpID As Long
    
    ' 提前获取当前用户ID，避免后续更新出错
    currentEmpID = TempVars("CurrentUserID").Value
    
    ' 直接插入完整会话记录，确保信息准确关联
    Set rs = CurrentDb.OpenRecordset("tbl12SessionLog", dbOpenDynaset)
    rs.AddNew
    rs!EmployeeID = currentEmpID
    rs!EmployeeName = TempVars("UserName").Value
    rs!SessionActivity = SessionActivity
    rs!TimeStamp = Now() ' 若表中TimeStamp为自动更新字段可省略此句
    rs.Update
    
    ' 登录时将最新SessionID存入临时变量
    If SessionActivity = "Log On" Then
        TempVars("CurrentSessionID") = rs!SessionID
    End If
    
    rs.Close
    Set rs = Nothing
End Sub

2. 优化会话查询，精准获取最新登录会话 #

原SQL的GROUP BY逻辑易导致分组偏差，改为直接筛选最新的单条登录记录：

SELECT TOP 1
    tbl12SessionLog.EmployeeID, tbl12SessionLog.EmployeeName, 
    tbl12SessionLog.SessionID, 
    tbl12SessionLog.SessionActivity, 
    tbl12SessionLog.TimeStamp,   
    tbl11Employee.Initials, qry01EmployeeAccess.PrivilegeID, 
    qry01EmployeeAccess.Privilege, qry01EmployeeAccess.FirstName
FROM 
    (tbl11Employee 
INNER JOIN 
    tbl12SessionLog ON tbl11Employee.EmployeeID = tbl12SessionLog.EmployeeID) 
INNER JOIN 
    qry01EmployeeAccess ON tbl11Employee.EmployeeID = qry01EmployeeAccess.EmployeeID
WHERE 
    tbl12SessionLog.EmployeeID = [TempVars]![CurrentUserID]
    AND tbl12SessionLog.SessionActivity = "Log On"
ORDER BY 
    tbl12SessionLog.TimeStamp DESC;

3. 登录时强制同步会话变量 #

在登录表单的确认按钮事件中，完成用户验证后立即调用会话记录函数，并同步加载最新权限信息：

Private Sub cmdLogin_Click()
    ' 省略用户验证逻辑，假设验证通过已设置TempVars("CurrentUserID")和TempVars("UserName")
    Call Session("Log On")
    LoadUserPermissions
End Sub

Private Sub LoadUserPermissions()
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("上述优化后的SQL查询")
    If Not rs.EOF Then
        TempVars("CurrentPrivilegeID") = rs!PrivilegeID
        TempVars("CurrentPrivilege") = rs!Privilege
    End If
    rs.Close
    Set rs = Nothing
End Sub

4. 增加会话有效性校验 #

在需要权限验证的表单加载或关键操作前，检查当前会话是否为最新：

Private Sub Form_Load()
    Dim latestSessionID As Long
    Dim rs As DAO.Recordset
    
    Set rs = CurrentDb.OpenRecordset("SELECT TOP 1 SessionID FROM tbl12SessionLog WHERE EmployeeID = " & TempVars("CurrentUserID") & " AND SessionActivity = 'Log On' ORDER BY TimeStamp DESC")
    latestSessionID = rs!SessionID
    rs.Close
    
    If TempVars("CurrentSessionID").Value <> latestSessionID Then
        MsgBox "会话已过期，请重新登录", vbExclamation
        DoCmd.OpenForm "frmLogin"
        DoCmd.Close acForm, Me.Name
    End If
    
    Set rs = Nothing
End Sub

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