要用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


发表评论