跨工作簿自动汇总

t502435282

zhaogang1960 发表于 2014-8-15 11:09
ADO法速度较快：

我的excel 是2016版  

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no';Data Source=" & File

这段老是报错

t502435282

zhaogang1960发表于2014-8-15 11:09
ADO法速度较快：

怎么抓取xlsx文件这样对吗  另外怎么添加指定路径
Sub Macro1（）
    Dim Fso As Object，File As Object，cnn As Object，SQL $，m＆
    Application.ScreenUpdating = False
    设置Fso = CreateObject（“Scripting.FileSystemObject”）
    ActiveSheet.UsedRange.Offset（309）.ClearContents
    ActiveSheet.UsedRange.Offset（309，1）.ClearContents
    对于Fso.GetFolder（ThisWorkbook.Path）.Files中的每个文件
        如果File.Name像“* .xlsx”和File.Name <> ThisWorkbook.Name那么
            m = m + 1
            如果m = 1那么
                Set cnn = CreateObject（“adodb.connection”）
                cnn.Open“Provider = Microsoft.Jet.OLEDB.4.0; Extended Properties ='Excel 8.0; hdr = no'; Data Source =”＆File
                SQL =“select * from [录入表$ g3：i309]”
                [a3] .CopyFromRecordset cnn.Execute（SQL）
            其他
                SQL = "select * from [Excel 8.0;hdr=no;Database=" & File & ";].[录入表$i3:i309]"
                Cells(3, m + 2).CopyFromRecordset cnn.Execute(SQL)
            End If
            Cells(3, m + 2) = Replace(File.Name, ".xlsx", "")
        End If
    Next
    Set Fso = Nothing
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
End Sub

zhaogang1960

t502435282 发表于 2018-2-3 10:18
怎么抓取xlsx文件这样对吗  另外怎么添加指定路径
Sub Macro1（）
    Dim Fso As Object，File As Obj ...

从Excel2007后

Jet.OLEDB.4.0
改为
.Ace.OLEDB.12.0

Excel 8.0
改为
Excel 12.0

Sub Macro1()
    Dim Fso As Object, File As Object, cnn As Object, SQL$, m&
    Application.ScreenUpdating = False
    Set Fso = CreateObject("Scripting.FileSystemObject")
    ActiveSheet.UsedRange.Offset(2, 1).ClearContents
    For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
        If File.Name Like "*.xlsx" Then
            m = m + 1
            If m = 1 Then
                Set cnn = CreateObject("adodb.connection")
                cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & File
                SQL = "select b.f2 from [Excel 12.0;hdr=no;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$a4:a" & Range("a" & Rows.Count).End(xlUp).Row & "] a left join [清算表$a3:b] b on a.f1=b.f1"
            Else
                SQL = "select b.f2 from [Excel 12.0;hdr=no;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$a4:a" & Range("a" & Rows.Count).End(xlUp).Row & "] a left join [Excel 12.0;hdr=no;Database=" & File & ";].[清算表$a3:b] b on a.f1=b.f1"
            End If
            Cells(4, m + 1).CopyFromRecordset cnn.Execute(SQL)
            Cells(3, m + 1) = Replace(File.Name, ".xls", "")
        End If
    Next
    Set Fso = Nothing
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
End Sub

jjmysjg

liu-aguang 发表于 2014-8-15 10:54

能否将上述代码改成自动汇总文件夹下的全部工作簿。
谢谢

归来1990

zhaogang1960 发表于 2018-2-3 22:35
从Excel2007后

Jet.OLEDB.4.0

SQL = "select b.f2 from [Excel 12.0;hdr=no;Database=" & ThisWorkbook.FullName & ";].[" & ActiveSheet.Name & "$a4:a" & Range("a" & Rows.Count).End(xlUp).Row & "] a left join [清算表$a3:b] b on a.f1=b.f1"

老师, 请问下, 这段里面的字段为啥是 a.f1  b.f1 这个f1是哪里来的呀, 这里看不太懂

舒云天

liu-aguang 发表于 2014-8-15 10:54

你好，如果各单位的工作簿同时有2003版，2007版的，如何一次性汇总？