MS Access VBA操作Excel文件后锁定问题及优化方案咨询

一、文件锁定的根源 #

原代码通过Excel.Application打开工作簿获取工作表名称，即便调用了.Close和.Quit，仍可能因以下原因导致Excel进程残留、文件被锁定：

• 代码执行中出现未捕获错误，导致资源释放代码（Set objWbk = Nothing等）未执行
• Excel后台进程未彻底终止（比如存在隐藏对话框、未处理的警告弹窗）
• 打开工作簿时未指定ReadOnly:=True参数，触发文件独占锁定

二、无需打开Excel的优化实现 #

我们可以通过ADO连接Excel文件读取工作表名称，同时用FileSystemObject直接完成文件复制，全程不启动Excel进程，从根源避免文件锁定问题。优化后的代码如下：

Private Sub cmdUpload_Click()
    Dim FileObject As Object
    Dim vFSO As Object
    Dim vDest As String
    Dim vRQID As Long
    Dim ary As Variant
    Dim vFile As String
    Dim vSelectedPath As String
    Dim conn As Object
    Dim rs As Object
    Dim sheetName As String
    
    vRQID = Me.requestID
    vDest = "C:\APP\Imports\Adjustment\" & vRQID & "\"
    Set vFSO = VBA.CreateObject("Scripting.FileSystemObject")
    Set FileObject = Application.FileDialog(3)
    
    FileObject.AllowMultiSelect = False
    If FileObject.Show = -1 Then
        vSelectedPath = FileObject.SelectedItems(1)
        ary = Split(vSelectedPath, "\")
        vFile = ary(UBound(ary))
        
        ' 创建目标文件夹（不存在则创建）
        If Not vFSO.FolderExists(vDest) Then
            vFSO.CreateFolder vDest
        End If
        
        ' 复制文件到附件文件夹
        vFSO.CopyFile vSelectedPath, vDest & vFile, OverWriteFiles:=True
        
        ' 插入附件记录到数据库（处理单引号避免SQL错误）
        CurrentDb.Execute "INSERT Into table_Attachment ([requestID],[FileName],[Path],[AddedBy]) " & _
                          "VALUES (" & vRQID & ", '" & Replace(vFile, "'", "''") & "','" & _
                          Replace(vDest & vFile, "'", "''") & "', '" & Replace(initUserName, "'", "''") & "');"
        
        ' 更新按钮标题
        Forms!form_Request_Adjustment!cmdAttach.Caption = " Attachments (" & _
                                                           DCount("[attachmentID]", "[table_Attachment]", "[requestID]=" & vRQID & ")"
        
        ' 通过ADO获取第一个可见工作表名称（无需打开Excel）
        Set conn = CreateObject("ADODB.Connection")
        Set rs = CreateObject("ADODB.Recordset")
        
        ' Excel 2007+ 适配的连接字符串
        conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & vSelectedPath & _
                  ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1"";"
        
        ' 获取所有工作表元数据
        Set rs = conn.OpenSchema(20) ' 对应adSchemaTables常量
        
        ' 过滤出第一个用户可见工作表（排除系统表和临时表）
        Do While Not rs.EOF
            sheetName = rs("TABLE_NAME").Value
            If Right(sheetName, 1) = "$" And Left(sheetName, 4) <> "MSys" Then
                sheetName = Left(sheetName, Len(sheetName) - 1) ' 去掉工作表名称末尾的$
                Exit Do
            End If
            rs.MoveNext
        Loop
        
        ' 释放ADO资源
        rs.Close
        conn.Close
        Set rs = Nothing
        Set conn = Nothing
        
        ' 校验工作表并导入数据
        If sheetName = "Upload" Then
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
                                      "QueryUpload", vSelectedPath, 1, "Upload!B4:AK"
        Else
            MsgBox "「Upload」工作表必须是工作簿中的第一个可见工作表才能上传"
        End If
    End If
    
    ' 释放剩余资源
    Set FileObject = Nothing
    Set vFSO = Nothing
End Sub

三、关键优化点说明 #

• 彻底规避Excel进程：用ADO读取Excel元数据，全程不依赖Excel应用，从根源消除文件锁定风险
• 补全文件复制逻辑：原代码遗漏文件复制步骤，优化后通过vFSO.CopyFile直接完成文件迁移
• SQL安全防护：对插入数据库的字符串做单引号转义处理，避免语法错误和注入风险
• 更可靠的工作表检测：过滤系统表和临时表，确保获取的是用户实际创建的工作表

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