使用ADO VBA复制Excel指定列时列名含点、空格报错如何解决

问题根因 #

• ACE OLEDB驱动开启HDR=YES模式读取Excel表头时，会自动将列名中的.替换为#做内部映射，直接用原列名加方括号查询会识别不到对应列，触发SQL语法错误。
• 原代码中的On Error Resume Next语句吞掉了SQL执行阶段的报错，导致RecordSet对象未成功打开，后续操作就会抛出「operation is not allowed when object is closed」的错误。
• 手动替换点为#的方案容易出现匹配偏差，尤其是列名同时包含空格、多个点的场景下容错性极低。

最优解决方法 #

无需修改两张工作表的原有列名，通过调整ADO读取逻辑完全规避特殊字符的影响，核心思路是：放弃依赖驱动自动解析表头的HDR=YES模式，改用HDR=NO将所有行视为普通数据，先匹配源表第一行的表头内容得到目标列的位置，用通用列名F1/F2/.../Fn查询数据，从根本上避免列名特殊字符导致的识别问题。

修改后的完整代码如下：

Sub CreateSummaryData()
    Dim oCon As Object, oRec As Object
    Dim strSQL As String
    Dim wb As Workbook, wk1 As Worksheet, wk2 As Worksheet
    Dim xLastColumn As Long, srcLastCol As Long, i As Long
    Dim xCell As Range, xRng As Range
    Dim srcHeaderArr, colMap As Object, selectCols As String
    
    ' 初始化字典存储原列名和列序号的映射关系
    Set colMap = CreateObject("Scripting.Dictionary")
    Set wb = ThisWorkbook
    Set wk1 = wb.Worksheets("Paste Data")
    Set wk2 = wb.Worksheets("Summary of data")
    
    ' 读取源表第一行表头，建立映射
    srcLastCol = wk1.Range("1:1").Cells(wk1.Columns.Count).End(xlToLeft).Column
    srcHeaderArr = wk1.Range(wk1.Cells(1, 1), wk1.Cells(1, srcLastCol)).Value
    For i = 1 To UBound(srcHeaderArr, 2)
        colMap(srcHeaderArr(1, i)) = i
    Next
    
    ' 拼接要查询的通用列名
    selectCols = ""
    With wk2
        xLastColumn = .Range("1:1").Cells(.Columns.Count).End(xlToLeft).Column
        If xLastColumn < 1 Then Exit Sub
        Set xRng = .Range(.Cells(1, 1), .Cells(1, xLastColumn))
        For Each xCell In xRng
            ' 如源表不存在对应列可自行添加容错逻辑
            If colMap.Exists(xCell.Value2) Then
                selectCols = selectCols & "F" & colMap(xCell.Value2) & ","
            End If
        Next
    End With
    If selectCols = "" Then Exit Sub
    selectCols = Left(selectCols, Len(selectCols) - 1)
    
    ' 初始化ADO连接，HDR设为NO关闭表头自动解析，IMEX=1设为读取模式
    Set oCon = CreateObject("ADODB.Connection")
    Set oRec = CreateObject("ADODB.Recordset")
    With oCon
        .Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='" & _
        wb.FullName & "';Extended Properties=""Excel 12.0; HDR=NO;IMEX=1"""
    End With
    
    ' 直接查询源表第二行开始的有效数据，避开原表头行
    strSQL = "SELECT " & selectCols & " FROM [" & wk1.Name & "$A2:" & _
             Split(wk1.Cells(1, srcLastCol).Address, "$")(1) & "]"
    
    ' 执行查询填充数据
    oRec.Open strSQL, oCon, 3, 3
    wk2.Range("A2:" & wk2.Cells(wk2.Rows.Count, xLastColumn).Address).ClearContents
    wk2.Range("A2").CopyFromRecordset oRec
    
    ' 释放资源
    oRec.Close
    oCon.Close
    Set oRec = Nothing
    Set oCon = Nothing
    Set colMap = Nothing
End Sub

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