使用ADODB提取关闭Excel文件数据时遇‘Could not find installable ISAM’错误求助

我正在编写一款程序，目标是选择未打开的Excel文件并从中提取数据（无需打开文件），但始终报错。之前从YouTube的Wise Owl处复制过一个同类型简易程序，原本能正常运行，现在也无法使用了。

以下是我的代码：

Sub GetDataFromClosedFile()
Dim cn As ADODB.Connection
Dim file As FileDialog
Dim sItem As String
Dim GetFile As String

Set file = Application.FileDialog(msoFileDialogFilePicker)
With file
    .Title = "Select a File"
    .AllowMultiSelect = False
    '.InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
    GetFile = sItem
    Set file = Nothing

Sheet1.Range("A1").CurrentRegion.Offset(1, 0).Clear

Set cn = New ADODB.Connection

cn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source= GetFile" & _
"Extended Properties='Excel 12.0 Xml;HDR=YES';"

cn.Open
cn.Close
End Sub

错误点及修正方案 #

• 连接字符串拼接错误：原代码中Data Source= GetFile直接写了变量名，没有完成字符串拼接，且参数间缺少分号分隔。正确写法应为：

  cn.ConnectionString = _
  "Provider=Microsoft.ACE.OLEDB.12.0;" & _
  "Data Source=" & GetFile & ";" & _
  "Extended Properties='Excel 12.0 Xml;HDR=YES';"
  

• 未处理取消选择的情况：如果用户在文件选择对话框点击取消，GetFile会是空值，后续连接会报错。需在NextCode后添加判断：

  NextCode:
      GetFile = sItem
      Set file = Nothing
      ' 若未选择文件则退出
      If GetFile = "" Then Exit Sub
  

• 缺少数据提取逻辑：当前代码仅完成连接的打开和关闭，没有执行查询读取数据。需添加ADODB.Recordset对象来执行查询并写入工作表，示例：

  Dim rs As ADODB.Recordset
  Set rs = New ADODB.Recordset
  ' 假设读取第一个工作表的数据，可替换为具体表名或SQL语句
  rs.Open "SELECT * FROM [Sheet1$]", cn
  ' 将数据写入Sheet1的A2开始位置
  Sheet1.Range("A2").CopyFromRecordset rs
  rs.Close
  Set rs = Nothing
  

• 驱动兼容性问题：若处理的是.xls格式文件，需将Extended Properties改为'Excel 8.0;HDR=YES'，同时确保已安装Microsoft Access Database Engine（ACE驱动）。

修正后的完整代码示例 #

Sub GetDataFromClosedFile()
Dim cn As ADODB.Connection
Dim file As FileDialog
Dim sItem As String
Dim GetFile As String
Dim rs As ADODB.Recordset

Set file = Application.FileDialog(msoFileDialogFilePicker)
With file
    .Title = "Select a File"
    .AllowMultiSelect = False
    '.InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
    GetFile = sItem
    Set file = Nothing
    ' 未选择文件则退出
    If GetFile = "" Then Exit Sub

Sheet1.Range("A1").CurrentRegion.Offset(1, 0).Clear

Set cn = New ADODB.Connection
cn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & GetFile & ";" & _
"Extended Properties='Excel 12.0 Xml;HDR=YES';"
cn.Open

' 读取数据并写入工作表
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM [Sheet1$]", cn
If Not rs.EOF Then
    Sheet1.Range("A2").CopyFromRecordset rs
End If

rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub

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