|
Sub test()
Dim d As Object, Cn As Object, Rs As Object, Sq$, p$, f$
Dim s$
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set Cn = CreateObject("ADODB.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
p = ThisWorkbook.Path & "\数据\"
f = Dir(p & "*.xlsx")
Do While f <> ""
If f <> ThisWorkbook.Name Then
s = Replace(f, ".xlsx", "")
Sq = "select '" & s & "' as 工作表名,sum(数量) as 汇总数量,sum(金额) as 汇总金额 FROM [Excel 12.0;Database=" & p & f & "].[$A5:G] WHERE 姓名 IS NOT NULL"
d(Sq) = ""
End If
f = Dir
Loop
If d.Count Then
Sq = Join(d.Keys, " UNION ALL ")
Set Rs = Cn.Execute(Sq)
Range("a2:c13").ClearContents
Range("A" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset Rs
End If
Cn.Close
Set Cn = Nothing
Set Rs = Nothing
Set d = Nothing
Application.ScreenUpdating = True
End Sub |
|