多个工作簿，求和，问题已在文件夹里面，请高手帮忙

zhouenming

新建文件夹.rar (35.35 KB, 下载次数: 6)

2011-12-24 20:59 上传

点击文件名下载附件

要计算公司每个月的出货量多少，每月统计，每个月的所有单据会放在一个文件夹里面，文件名为单据号从00565开始，具体问题在文件里面，在线等待高手解答。

zhouenming

没人帮忙解决吗?........

zhaogang1960

1. Sub Macro1()
   
2.     Dim cnn As Object, SQL$, p$, f$, m&
   
3.     p = ThisWorkbook.Path & ""
   
4.     f = Dir(p & "*.xlsx")
   
5.     Set cnn = CreateObject("adodb.connection")
   
6.     Do While f <> ""
   
7.         m = m + 1
   
8.         If m = 1 Then
   
9.             cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='excel 12.0;hdr=no';Data Source=" & p & f
   
10.             SQL = "select * from [SURAT JALAN$r2:r2]"
    
11.         Else
    
12.             SQL = SQL & " union all select * from [Excel 12.0;hdr=no;Database=" & p & f & "].[SURAT JALAN$r2:r2]"
    
13.         End If
    
14.         f = Dir()
    
15.     Loop
    
16.     SQL = "select sum(f1) from (" & SQL & ")"
    
17.     [c4].CopyFromRecordset cnn.Execute(SQL)
    
18.     cnn.Close
    
19.     Set cnn = Nothing
    
20. End Sub
    

复制代码

zhaogang1960

请看附件

12月份出货量.rar (41.7 KB, 下载次数: 34)

2011-12-24 15:44 上传

点击文件名下载附件

zhouenming

出现错误，能不能再帮我再修改一下。谢谢。

zhouenming

新的内容在新建文件夹里面，请各位高手帮帮忙

zhouenming

版主，能帮我再解答吗，谢谢啦

zhaogang1960

原附件是2007格式，不适应2003格式的工作簿，下面是2003格式代码：

1. Sub Macro1() 'excel2003
   
2.     Dim cnn As Object, SQL$, p$, f$, m&
   
3.     p = ThisWorkbook.Path & ""
   
4.     f = Dir(p & "*.xls")
   
5.     Set cnn = CreateObject("adodb.connection")
   
6.     Do While f <> ""
   
7.         If f <> ThisWorkbook.Name Then
   
8.             m = m + 1
   
9.             If m = 1 Then
   
10.                 cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties='excel 8.0;hdr=no';Data Source=" & p & f
    
11.                 SQL = "select * from [SURAT JALAN$r2:r2]"
    
12.             Else
    
13.                 SQL = SQL & " union all select * from [Excel 8.0;hdr=no;Database=" & p & f & "].[SURAT JALAN$r2:r2]"
    
14.             End If
    
15.         End If
    
16.         f = Dir()
    
17.     Loop
    
18.     SQL = "select sum(f1) from (" & SQL & ")"
    
19.     [c4].CopyFromRecordset cnn.Execute(SQL)
    
20.     cnn.Close
    
21.     Set cnn = Nothing
    
22. End Sub
    

复制代码

LMY123

SQL = SQL & " union all select * from [Excel 12.0;hdr=no;Database=" & p & f & "].[SURAT JALAN$r2:r2]"