|
Sub limonet()
Dim Cn As Object, StrSQL$, Path$, Filename$
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
Path = ThisWorkbook.Path & "\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
If Not Filename Like "*.xlsm" Then
StrSQL = StrSQL & " Union All Select '" & Replace(Filename, ".", "' As Name,'") & _
"' As Ex,* From [Excel 12.0;Hdr=No;Database=" & Path & Filename & "].[Export$A2:A]"
End If
Filename = Dir
Loop
StrSQL = "Select name,Ex,Count(*)-1 From (" & Mid(StrSQL, 12) & ") Group By name,Ex"
Range("B3").CopyFromRecordset Cn.Execute(StrSQL)
End Sub |
|