多用户Access表单VBA导入Excel后文件锁定问题求助

你的判断没错——TransferSpreadsheet做的是静态导入而非链接，但原文件仍被锁定的原因是：Access执行导入操作后，有时不会立即释放对Excel文件的文件句柄，尤其是当表单全天保持开启、多用户同时运行时，这个句柄会被持续占用，导致你无法覆盖或编辑原文件。

下面是几个可行的解决方案，按推荐程度排序：

方案1：导入临时副本（最稳妥） #

核心思路是：先把原Excel文件复制到临时目录，导入这个临时副本，操作完成后删除临时文件。这样原文件从头到尾都不会被Access占用，用户可以随时更新它。

修改后的VBA代码如下：

Option Compare Database
Private Sub Command0_Click()
    Dim fso As Object
    Dim tempFilePath As String
    Dim originalFilePath As String
    
    ' 原文件路径
    originalFilePath = "C:\Users\JohnDoe\Documents\MyTable.xlsx"
    ' 临时文件路径（放在系统临时文件夹）
    tempFilePath = Environ("TEMP") & "\Temp_MyTable.xlsx"
    
    On Error GoTo Cleanup ' 添加错误处理，确保临时文件能被删除
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 复制原文件到临时位置（覆盖已存在的临时文件）
    fso.CopyFile originalFilePath, tempFilePath, True
    
    DoCmd.SetWarnings False
    ' 清空目标表
    DoCmd.RunSQL "DELETE ExcelTable.* FROM ExcelTable;"
    ' 导入临时文件
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
        "ExcelTable", tempFilePath, True, "Data!A6:DB" & numberofrows
    DoCmd.SetWarnings True
    
Cleanup:
    ' 释放对象并删除临时文件
    Set fso = Nothing
    ' 即使出错，也要尝试删除临时文件
    If Dir(tempFilePath) <> "" Then
        Kill tempFilePath
    End If
    ' 恢复错误提示（如果有异常）
    If Err.Number <> 0 Then
        MsgBox "导入出错：" & Err.Description, vbExclamation
        DoCmd.SetWarnings True ' 确保警告功能被恢复
    End If
End Sub

方案2：用API强制释放文件句柄 #

如果你不想用临时文件，可以尝试调用Windows API来强制释放Access占用的文件句柄。不过这个方法兼容性稍差，需要注意32位/64位Access的区别：

Option Compare Database
Private Declare PtrSafe Function CloseHandle Lib "kernel32.dll" (ByVal hObject As LongPtr) As Boolean
Private Declare PtrSafe Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPtr
Private Declare PtrSafe Function FindClose Lib "kernel32.dll" (ByVal hFindFile As LongPtr) As Boolean

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 260
    cAlternate As String * 14
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Sub Command0_Click()
    Dim filePath As String
    Dim hFind As LongPtr
    Dim findData As WIN32_FIND_DATA
    
    filePath = "C:\Users\JohnDoe\Documents\MyTable.xlsx"
    
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE ExcelTable.* FROM ExcelTable;"
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
        "ExcelTable", filePath, True, "Data!A6:DB" & numberofrows
    DoCmd.SetWarnings True
    
    ' 尝试释放文件句柄
    hFind = FindFirstFile(filePath, findData)
    If hFind <> -1 Then
        FindClose hFind
    End If
End Sub

注意：这个方法不一定在所有环境下都生效，64位Access必须确保PtrSafe声明正确。

方案3：排查潜在的隐性绑定 #

虽然你说导入的是静态表，但还是要快速检查：

• 表单的记录源是否是关联了Excel链接表的查询？
• 有没有其他后台VBA代码打开了Excel对象但未正确释放（比如遗漏Set xlApp = Nothing）？

如果存在这类情况，要确保所有Excel相关的对象都被彻底释放。

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