如何在vba中用ado合并多个工作表的内容?

要用ado合并多个工作表的内容可以使用sql语句 union all 。

以下是在vba中用ado合并当前工作簿的所有工作表内容的示例代码:

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Excel.Application.DisplayAlerts = False
    Excel.Application.Calculation = xlCalculationManual
    Dim oRecrodset As Object
    Dim oConStr As Object
    Dim sSql As String
    Dim oWk As Worksheet
    Dim arr()
    For Each oWk In Excel.Worksheets
        If oWk.Name <> "汇总" Then
            ReDim Preserve arr(k)
            arr(k) = " select * from [" & oWk.Name & "$] "
            k = k + 1
        End If
    Next
    'sql语句
    sSql = Join(arr, " union all ")
    Dim sFilePath As String
    '固定链接
    sFilePath = Excel.ThisWorkbook.FullName
    Dim sConStr As String
    Dim sVersion  As String
    Set oWk = ThisWorkbook.Worksheets.Add
    sVersion = Excel.Application.Version
    '创建连接字符串
    If sVersion <= 12 Then
        sConStr = "Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" & sFilePath & ";Extended Properties='Excel 8.0;HDR=YES'"
    Else
        sConStr = "Provider='Microsoft.ACE.OLEDB.12.0';Data Source=" & sFilePath & ";Extended Properties='Excel 12.0;HDR=YES'"
    End If
    Debug.Print sConStr
    Set oConStr = CreateObject("ADODB.Connection")
    '使用Connection连接数据源,并用Execute方法执行对应的SQL语句生成Recrodset对象
    With oConStr
        .Open sConStr
        Set oRecrodset = .Execute(sSql)
    End With
    With oRecrodset
        '循环导入字段名
        For i = 1 To .Fields.Count
            oWk.Cells(1, i) = .Fields(i - 1).Name
        Next
        oWk.Cells(2, 1).CopyFromRecordset oRecrodset
    End With
    Excel.Application.Calculation = xlCalculationAutomatic
    Excel.Application.DisplayAlerts = True
    Excel.Application.ScreenUpdating = True
    Set oConStr = Nothing
    Set oRecrodset = Nothing
End Sub
       

发表评论