使用ADODB从关闭工作簿取数时，如何合并两个单元格内容至主表？

我有一个主工作簿，想用ADODB从另一个目标工作簿导入数据，需要把目标工作簿里两个单元格的内容合并后，存入主工作簿的单个单元格中。我参考WiseOwl的YouTube视频写了基础代码并做了调整，现在需要技术帮助。

当前代码 #

Option Explicit

Sub ImportDataFromFinishedTravelRequest() 
    Dim cn As ADODB.Connection 
    Dim file As FileDialog 
    Dim sItem As String 
    Dim GetFile As String 
    Dim rs As ADODB.Recordset 
    Dim unusedRow As Long
   
    '确定下一个空行
    With Sheets("NEW TR Matrix")
        unusedRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    End With

    '选择要导入数据的文件
    Set file = Application.FileDialog(msoFileDialogFilePicker)
    With file
        .Title = "选择文件"
        .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=No';"

    cn.Open

        Set rs = New ADODB.Recordset
        rs.ActiveConnection = cn
        rs.Source = "SELECT * FROM [$J14:J14]" & "SELECT * FROM [$J15:J15]"
        rs.Open

        '选择主工作表中要写入数据的单元格
        Sheet1.Range("G" & unusedRow).CopyFromRecordset rs

        rs.Close

    cn.Close

End Sub

问题分析与修复方案 #

当前代码用两个独立SELECT语句会返回两行记录，CopyFromRecordset会将它们写入两个单元格，无法实现合并需求。需要在SQL查询中直接拼接两个单元格的内容，返回单个值。

修改后的核心逻辑 #

将原rs.Source语句替换为：

rs.Source = "SELECT F1 & ' ' & F2 FROM (SELECT * FROM [$J14:J15])"

• 因HDR=No，OLEDB用F1、F2指代查询范围的第一、第二列（J14对应F1，J15对应F2）
• 子查询将两个单元格转为一行的两列，主查询拼接这两个字段，返回单个合并值
• 可根据需求调整分隔符，比如用', '替换' '实现逗号分隔

完整修改代码 #

Option Explicit

Sub ImportDataFromFinishedTravelRequest() 
    Dim cn As ADODB.Connection 
    Dim file As FileDialog 
    Dim sItem As String 
    Dim GetFile As String 
    Dim rs As ADODB.Recordset 
    Dim unusedRow As Long
   
    '确定下一个空行
    With Sheets("NEW TR Matrix")
        unusedRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
    End With

    '选择要导入数据的文件
    Set file = Application.FileDialog(msoFileDialogFilePicker)
    With file
        .Title = "选择文件"
        .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=No';"

    cn.Open

        Set rs = New ADODB.Recordset
        rs.ActiveConnection = cn
        '拼接J14和J15的内容为单个字段
        rs.Source = "SELECT F1 & ' ' & F2 FROM (SELECT * FROM [$J14:J15])"
        rs.Open

        '将合并后的值写入单个单元格
        Sheet1.Range("G" & unusedRow).CopyFromRecordset rs

        rs.Close

    cn.Close

End Sub

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