VBA+ADO跨Excel与SQL Server数据源关联查询报错求助

你的代码存在几个关键问题，导致运行报错，逐一说明并修正：

1. 语法错误：变量声明多余逗号 #

原代码中变量声明行末尾多了一个逗号，会触发编译错误：

Dim strConn As String, strConnSQL As String, fldCount As Long, iCol As Long, Slct As String, SQLfrom As String, 

修正：删除末尾的逗号：

Dim strConn As String, strConnSQL As String, fldCount As Long, iCol As Long, Slct As String, SQLfrom As String

2. Excel表名格式错误 #

原代码中表名的反引号和多引号格式不符合ACE OLEDB规范，ACE连接Excel时，工作表名应使用[表名$]格式：

BouncePNs = "`" & ThisWorkbook.Sheets("Sheet1").Name & "$`"""

修正：改为标准格式，同时添加变量声明：

Dim BouncePNs As String
BouncePNs = "[" & ThisWorkbook.Sheets("Sheet1").Name & "$]"

3. 核心错误：跨数据源关联的实现方式错误 #

你不能同时给Recordset设置两个ActiveConnection，这是无效的。跨Excel和SQL Server的关联查询需要用分布式查询，以下提供两种可行方案：

方案1：通过SQL Server连接查询Excel（推荐，适合SQL端数据量较大场景） #

利用SQL Server的OPENROWSET函数直接读取当前Excel文件，在SQL语句中完成关联：

Sub QueryExcelFromSQL()
    Dim cnSQL As ADODB.Connection
    Set cnSQL = New ADODB.Connection
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strConnSQL As String
    Dim sql As String
    Dim excelPath As String
    
    ' Excel文件路径（注意：SQL Server服务账户需要有该文件的读取权限）
    excelPath = ThisWorkbook.FullName
    
    ' SQL Server连接字符串
    strConnSQL = "PROVIDER=SQLOLEDB;" & _
                 "SERVER=XXSQLP02\XXSQLP02;" & _
                 "UID=product_user;" & _
                 "PWD=xxxx;" & _
                 "Database=product"
    cnSQL.Open strConnSQL
    
    ' 构建包含OPENROWSET的SQL语句，关联Excel表和SQL视图
    sql = "SELECT excel.Whse, excel.Mfg, vwPart.[Part Number] " & _
          "FROM OPENROWSET('Microsoft.ACE.OLEDB.12.0', " & _
          "'Excel 12.0 Xml;HDR=YES;Database=" & excelPath & "', " & _
          "'SELECT * FROM [Sheet1$]') AS excel " & _
          "LEFT OUTER JOIN vwPart ON excel.PN = vwPart.[Part Number]"
    
    ' 执行查询并导出到新工作簿
    Workbooks.Add
    rs.Open sql, cnSQL
    ' 写入表头
    Dim iCol As Long
    For iCol = 1 To rs.Fields.Count
        Cells(1, iCol).Value = rs.Fields(iCol - 1).Name
    Next iCol
    ' 写入数据
    Cells(2, 1).CopyFromRecordset rs
    
    ' 清理资源
    rs.Close
    cnSQL.Close
    Set rs = Nothing
    Set cnSQL = Nothing
End Sub

注意：使用此方案需要确保SQL Server的Ad Hoc Distributed Queries选项已启用，且SQL Server服务账户能访问你的Excel文件路径。

方案2：通过Excel连接查询SQL Server表（适合Excel数据量较小场景） #

利用Excel的ACE连接，通过OPENDATASOURCE读取SQL Server视图，在Excel端完成关联：

Sub QuerySQLFromExcel()
    Dim cnExcel As ADODB.Connection
    Set cnExcel = New ADODB.Connection
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Dim strConnExcel As String
    Dim sql As String
    Dim BouncePNs As String
    
    BouncePNs = "[" & ThisWorkbook.Sheets("Sheet1").Name & "$]"
    
    ' Excel连接字符串
    strConnExcel = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                   "Data Source=" & ThisWorkbook.FullName & ";" & _
                   "Extended Properties=""Excel 12.0 Xml;HDR=YES"""
    cnExcel.Open strConnExcel
    
    ' 构建关联SQL，通过OPENDATASOURCE访问SQL Server视图
    sql = "SELECT excel.Whse, excel.Mfg, sqlPart.[Part Number] " & _
          "FROM " & BouncePNs & " AS excel " & _
          "LEFT OUTER JOIN OPENDATASOURCE('SQLOLEDB', " & _
          "'PROVIDER=SQLOLEDB;SERVER=XXSQLP02\XXSQLP02;UID=product_user;PWD=xxxx;Database=product').product.dbo.vwPart AS sqlPart " & _
          "ON excel.PN = sqlPart.[Part Number]"
    
    ' 执行查询并导出到新工作簿
    Workbooks.Add
    rs.Open sql, cnExcel
    ' 写入表头
    Dim iCol As Long
    For iCol = 1 To rs.Fields.Count
        Cells(1, iCol).Value = rs.Fields(iCol - 1).Name
    Next iCol
    ' 写入数据
    Cells(2, 1).CopyFromRecordset rs
    
    ' 清理资源
    rs.Close
    cnExcel.Close
    Set rs = Nothing
    Set cnExcel = Nothing
End Sub

4. 其他细节优化 #

• 在模块顶部添加Option Explicit，强制显式声明变量，避免未声明变量导致的隐性错误。
• SQL语句中的JOIN关键字和ON之间要留空格，避免语法错误。

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