如何在VBA中获取保存时的未保存对象名称（Forms、Reports、Modules）

Hey there! I've built a similar object locking system for Access team collaboration before, so I can walk you through the key steps and code implementations to meet your needs.

The goal is to capture the names of objects (Forms, Reports, Modules) when a developer saves them, sync this info to a shared database for locking, and notify other devs about active locks. We'll use Access Application events for Forms/Reports and VBE events for Modules, since module saves happen in the VBA editor.

First, create a class module to listen for Access's global save events.

1. Create a new class module named clsAppEvents and paste this code:

Option Explicit
Private WithEvents appAccess As Access.Application

Public Sub Initialize()
    Set appAccess = Application
End Sub

' Triggered right before any object is saved
Private Sub appAccess_ItemBeforeSave(ByVal Item As Object, Cancel As Boolean)
    Dim objType As String
    Dim objName As String
    
    ' Identify the object type
    Select Case TypeName(Item)
        Case "Form"
            objType = "Form"
            objName = Item.Name
        Case "Report"
            objType = "Report"
            objName = Item.Name
        Case Else
            ' Skip unsupported object types if needed
            Exit Sub
    End Select
    
    ' Sync lock info to shared database
    SyncObjectLock objType, objName, Environ("Username")
    
    ' Optional: Block save if object is locked by someone else
    ' Add check here and set Cancel = True if needed
End Sub

' Triggered when an object is closed (for auto-unlocking)
Private Sub appAccess_ItemClose(ByVal Item As Object, Cancel As Boolean)
    Dim objType As String
    Dim objName As String
    
    Select Case TypeName(Item)
        Case "Form", "Report"
            objType = TypeName(Item)
            objName = Item.Name
            UnlockObject objType, objName, Environ("Username")
    End Select
End Sub

2. Initialize this class when the database opens. Open the ThisDatabase module and add:

Option Explicit
Private appEvents As clsAppEvents

Private Sub Database_Open()
    Set appEvents = New clsAppEvents
    appEvents.Initialize
End Sub

Module saves happen in the VBA editor, so we need a separate class to listen to VBE events.

1. Create a new class module named clsVBEEvents and paste this code:

Option Explicit
Private WithEvents vbeEvents As VBIDE.VBE

Public Sub Initialize()
    Set vbeEvents = Application.VBE
End Sub

' Triggered before the VBA project is saved
Private Sub vbeEvents_BeforeSave(ByVal VBProject As VBIDE.VBProject, Cancel As Boolean)
    Dim comp As VBIDE.VBComponent
    
    ' Loop through all components to find modified modules
    For Each comp In VBProject.VBComponents
        If comp.Modified Then
            SyncObjectLock "Module", comp.Name, Environ("Username")
            comp.Modified = False ' Mark as saved to avoid duplicate triggers
        End If
    Next comp
End Sub

2. Update the ThisDatabase module to initialize this class too:

Option Explicit
Private appEvents As clsAppEvents
Private vbeEvents As clsVBEEvents

Private Sub Database_Open()
    Set appEvents = New clsAppEvents
    appEvents.Initialize
    
    Set vbeEvents = New clsVBEEvents
    vbeEvents.Initialize
End Sub

First, create a table named ObjectLocks in your shared database with these fields:

• ObjectType (Text, 50)
• ObjectName (Text, 100)
• LockedBy (Text, 50)
• LockTime (Date/Time)
• IsActive (Yes/No)

Then add these helper functions to a standard module (e.g., modLocking):

Option Explicit

Public Sub SyncObjectLock(objType As String, objName As String, lockedBy As String)
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strConn As String
    
    ' Replace with your shared database connection string
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\YourServer\SharedDB.accdb;Persist Security Info=False;"
    
    On Error GoTo ErrorHandler
    
    Set conn = New ADODB.Connection
    conn.Open strConn
    
    ' Check if the object is already locked by someone else
    Set rs = conn.Execute("SELECT * FROM ObjectLocks WHERE ObjectType='" & objType & "' " & _
                          "AND ObjectName='" & objName & "' AND IsActive=True")
    
    If rs.EOF Then
        ' No active lock - create a new lock record
        conn.Execute "INSERT INTO ObjectLocks (ObjectType, ObjectName, LockedBy, LockTime, IsActive) " & _
                     "VALUES ('" & objType & "', '" & objName & "', '" & lockedBy & "', Now(), True)"
    Else
        If rs("LockedBy") = lockedBy Then
            ' Update lock time if current user owns the lock
            conn.Execute "UPDATE ObjectLocks SET LockTime=Now() WHERE ObjectType='" & objType & "' " & _
                          "AND ObjectName='" & objName & "'"
        Else
            ' Warn user the object is locked by someone else
            MsgBox "Warning: " & objType & " '" & objName & "' is locked by " & rs("LockedBy") & "!", vbExclamation
            ' Uncomment below to block saving
            ' Cancel = True
        End If
    End If
    
Cleanup:
    If Not rs Is Nothing Then rs.Close
    If Not conn Is Nothing Then conn.Close
    Set rs = Nothing
    Set conn = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox "Failed to sync lock info: " & Err.Description, vbCritical
    Resume Cleanup
End Sub

Public Sub UnlockObject(objType As String, objName As String, lockedBy As String)
    Dim conn As ADODB.Connection
    Dim strConn As String
    
    strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=\\YourServer\SharedDB.accdb;Persist Security Info=False;"
    
    On Error GoTo ErrorHandler
    
    Set conn = New ADODB.Connection
    conn.Open strConn
    
    ' Mark the lock as inactive when the object is closed
    conn.Execute "UPDATE ObjectLocks SET IsActive=False WHERE ObjectType='" & objType & "' " & _
                  "AND ObjectName='" & objName & "' AND LockedBy='" & lockedBy & "'"
    
Cleanup:
    If Not conn Is Nothing Then conn.Close
    Set conn = Nothing
    Exit Sub
    
ErrorHandler:
    MsgBox "Failed to unlock object: " & Err.Description, vbCritical
    Resume Cleanup
End Sub

• Connection String: Adjust the connection string in the helper functions to match your shared database (SQL Server, Access, etc.).
• Lock Behavior: Decide if you want soft locks (just warn) or hard locks (block saves). Modify the ItemBeforeSave event to set Cancel = True if you want hard locks.
• Auto-Unlock: The ItemClose event handles auto-unlocking when forms/reports are closed. For modules, you might want to add a database close event to unlock all modules owned by the current user.
• Error Handling: The code includes basic error handling, but you can expand it to handle edge cases like network outages.

内容的提问来源于stack exchange，提问作者neo-ray