VBA使用ADO连接已打开Excel工作簿报连接丢失错误如何解决？

问题结论 #

1. ADO并非仅支持连接关闭状态的Excel工作簿，可正常读取已打开的文件，你遇到的报错是OLEDB驱动默认配置被打开文件的独占锁拦截导致，调整连接参数即可解决。

具体修复方案 #

现有代码缺少只读连接配置，无法绕过打开文件的独占锁校验，需修改连接字符串，同时建议新增对象释放逻辑避免残留文件句柄。
注：如果你的所有源工作簿的数据源都固定存放在Sheet1，现有查询语句无需修改；如果不同源工作簿的数据源工作表名不同，可新增参数传入源工作表名替换固定的[Sheet1$]即可

修正后完整代码

Sub callstuff()
    Call GetDataFromClosedFile("Movies1.xlsm", "sheet2", "Helper1")
    'Call GetDataFromClosedFile("Movies2.xlsm", "sheet3", "Helper2")
    'Call GetDataFromClosedFile("Movies3.xlsm", "sheet4", "Helper3")
    'Call GetDataFromClosedFile("Movies4.xlsm", "sheet5", "Helper4")
    'Call GetDataFromClosedFile("Movies5.xlsm", "sheet6", "Helper5")
    'Call GetDataFromClosedFile("Movies6.xlsm", "sheet7", "Helper6")
    'Call GetDataFromClosedFile("Movies7.xlsm", "sheet8", "Helper7")
    'Call GetDataFromClosedFile("Movies8.xlsm", "sheet9", "Helper8")
    'Call GetDataFromClosedFile("Movies8.xlsm", "sheet10", "Helper9")
    'Call GetDataFromClosedFile("Movies8.xlsm", "sheet11", "Helper10")
    'Call GetDataFromClosedFile("Movies8.xlsm", "sheet12", "Helper11")
    'Call GetDataFromClosedFile("Movies8.xlsm", "sheet13", "Helper12")
End Sub

Option Explicit

Sub GetDataFromClosedFile(WorkBookName As String, SheetName As String, TableName As String)
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim path As String
    Dim rngTable As Range

    path = "C:\Users\dima\OneDrive - ort braude college of engineering\Desktop\New folder (5)\" '常量路径
    
    '清空目标区域
    Worksheets(SheetName).Range("j4").CurrentRegion.Clear
    
    Set cn = New ADODB.Connection
    '修改连接字符串，新增ReadOnly=1参数绕过锁校验，IMEX=1避免混合数据类型读取错误
    cn.ConnectionString = _
        "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=" & path & WorkBookName & ";" & _
        "Extended Properties='Excel 12.0 Macro;HDR=YES;ReadOnly=1;IMEX=1';"
        
    cn.Mode = adModeRead
    cn.Open
    
    Set rs = New ADODB.Recordset
    rs.ActiveConnection = cn
    rs.Source = "SELECT * FROM [Sheet1$] "
    rs.Open
    
    '写入目标区域
    Worksheets(SheetName).Range("j4").CopyFromRecordset rs
    
    '释放对象，避免残留句柄占用文件
    rs.Close
    cn.Close
    Set rs = Nothing
    Set cn = Nothing
    
    '创建结构化表
    Set rngTable = Worksheets(SheetName).Range("j4").CurrentRegion
    Worksheets(SheetName).ListObjects.Add(xlSrcRange, rngTable, , xlNo).Name = TableName
End Sub

额外注意事项 #

• 如果源文件是共享打开的状态，上述修改可以直接正常读取
• 如果源文件是被其他用户以独占模式打开，仍然会遇到权限报错，这种场景下只能要求对方以共享模式打开文件，或者等文件关闭后再读取
• ADO仅能读取源文件已保存的内容，未保存的修改不会被读取到

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