要用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
发表评论