|
Sub Macro1()
Dim Fso As Object, File As Object
Dim cnn As Object, rs As Object, SQL$
Dim arr(), m&
Application.ScreenUpdating = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set cnn = CreateObject("adodb.connection")
ReDim arr(1 To Fso.GetFolder(ThisWorkbook.Path & "\汇总示意表").Files.Count, 1 To 2)
For Each File In Fso.GetFolder(ThisWorkbook.Path & "\汇总示意表").Files
If File.Name Like "*.xlsx" Then
m = m + 1
If m = 1 Then cnn.Open "Provider=Microsoft.ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & File
SQL = "select f1 from [Excel 12.0;hdr=no;Database=" & File & ";].[Sheet1$c2:c2]"
Set rs = cnn.Execute(SQL)
arr(m, 1) = rs.Fields(0)
SQL = "select sum(f1) from [Excel 12.0;hdr=no;Database=" & File & ";].[Sheet1$F4:H] where f3 is not null"
Set rs = cnn.Execute(SQL)
arr(m, 2) = rs.Fields(0)
End If
Next
ActiveSheet.UsedRange.Offset(1).ClearContents
[a2].Resize(m, 2) = arr
Set File = Nothing
Set Fso = Nothing
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
End Sub
http://club.excelhome.net/thread-1173932-1-1.html |
评分
-
2
查看全部评分
-
|