对同一文件夹下的多个ACCESS数据库执行同一查询并将结果导入EXCEL

telescope

麻烦各路高手帮忙！！

一个文件夹内有若干文件，每个文件包含了一周七天的数据。目的是想提取每一个文件中的每一天15点到17点ACC为1、Flagdown为1的汇总，以及Speed的平均数。如：对Database1文件中，提取7月5日、6日...到11日每天的ACC和Flagdown数汇总并录入EXCEL表中：

Date	Time Period	ACC Count （计数）	Flagdown Count （计数）	Speed （平均数）
5/7/2009	15:00:00-17:00:00	x	y	z
6/7/2009	15:00:00-17:00:00	m	n	i
7/7/2009	15:00:00-17:00:00	a	b	c
…	…	…	…	…
…	…	…	…	…
…	…	…	…	…

然后对Database2内的数据进行同样的查询，并继续录入同一个EXCEL表中。此后，对Database3,Database4进行同样处理。

查询的SQL为：

SELECT Week2.GmtDtTm, Week2.SpeedKmHr,Week2.ACC, Week2.FlagDown

FROM Week2

WHERE(((Week2.GmtDtTm) Between #5/7/2009 15:0:0# And #5/7/2009 17:0:0#) AND((Week2.ACC)=1) AND ((Week2.FlagDown)=1));

能不能有一个VBA方案可以自动对每一个文件执行同样操作？具体文件示例在附件中。

跪谢各位高手！！！！！

Sample.zip (923.75 KB, 下载次数: 31)

2014-12-6 22:29 上传

点击文件名下载附件

zhaogang1960

请参考：

1. Sub 联合查询()
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim SQL As String
   
5.     Dim myPath As String
   
6.     Dim myName As String
   
7.     Dim flag As Boolean
   
8.     myPath = ThisWorkbook.Path & ""
   
9.     myName = Dir(myPath & "*.accdb")
   
10.     Do While myName <> ""
    
11.         If Not flag Then
    
12.             cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myPath & myName
    
13.             SQL = "SELECT GmtDtTm,SpeedKmHr,ACC,FlagDown FROM Week2 WHERE (((GmtDtTm) Between #5/7/2009 10:0:0# And #7/7/2009 15:0:0#) AND ((ACC)=1) AND ((FlagDown)=1))"
    
14.             flag = True
    
15.         Else
    
16.             SQL = SQL & " UNION ALL SELECT GmtDtTm,SpeedKmHr,ACC,FlagDown FROM [MS Access;pwd=;Database=" & myPath & myName & ";].Week2 WHERE (((GmtDtTm) Between #5/7/2009 10:0:0# And #7/7/2009 15:0:0#) AND ((ACC)=1) AND ((FlagDown)=1))"
    
17.         End If
    
18.         myName = Dir
    
19.     Loop
    
20.     Range("A6:E" & Rows.Count).ClearContents
    
21.     Range("A6").CopyFromRecordset cnn.Execute(SQL)
    
22.     cnn.Close
    
23.     Set cnn = Nothing
    
24. End Sub
    

复制代码

zhaogang1960

如果ACCESS数据库文件数超过49个，程序需要修改
请测试附件
Sample.rar (591.78 KB, 下载次数: 98)

2014-12-6 23:47 上传

点击文件名下载附件

telescope

zhaogang1960 发表于 2014-12-6 23:47
如果ACCESS数据库文件数超过49个，程序需要修改
请测试附件

大神太伟大了！！！万分感谢！！！！实际情况是数据库文件有131个，请问应该怎么修改代码呢？或者把131个文件分到3个文件夹里可以么？

zhaogang1960

telescope 发表于 2014-12-7 21:39
大神太伟大了！！！万分感谢！！！！实际情况是数据库文件有131个，请问应该怎么修改代码呢？或者把131个 ...

1. Sub 联合查询()
   
2. '引用Microsoft ActiveX Data Objects 2.x Library
   
3.     Dim cnn As New ADODB.Connection
   
4.     Dim SQL As String
   
5.     Dim MyPath As String
   
6.     Dim myName As String
   
7.     Dim flag As Boolean
   
8.     Dim m As Integer
   
9.     Application.ScreenUpdating = False
   
10.     MyPath = ThisWorkbook.Path & ""
    
11.     myName = Dir(MyPath & "*.accdb")
    
12.     Range("A6:E" & Rows.Count).ClearContents
    
13.     Do While myName <> ""
    
14.         If Not flag Then
    
15.             cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyPath & myName
    
16.             flag = True
    
17.         End If
    
18.         m = m + 1
    
19.         If m > 49 Then
    
20.             Range("a" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
    
21.             m = 1
    
22.             SQL = ""
    
23.         End If
    
24.         If Len(SQL) Then SQL = SQL & " union all "
    
25.         SQL = SQL & "SELECT GmtDtTm,SpeedKmHr,ACC,FlagDown FROM [MS Access;pwd=;Database=" & MyPath & myName & ";].Week2 WHERE (((GmtDtTm) Between #5/7/2009 10:0:0# And #7/7/2009 15:0:0#) AND ((ACC)=1) AND ((FlagDown)=1))"
    
26.         myName = Dir
    
27.     Loop
    
28.     If Len(SQL) Then Range("a" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset cnn.Execute(SQL)
    
29.     cnn.Close
    
30.     Set cnn = Nothing
    
31.     Application.ScreenUpdating = True
    
32. End Sub
    

复制代码

zhaogang1960

请测试附件
Data.rar (18.77 KB, 下载次数: 85)

2014-12-7 22:00 上传

点击文件名下载附件

telescope

zhaogang1960 发表于 2014-12-7 22:01
请测试附件

谢谢大神指导！还想补充请教一下：现在数据库里的日期和时间保存成DD/MM/YYYY HH:MM:SS格式，并没有分开日期列和时间列。那么如果我想对每一个数据库文件提取每一天的15点到17点，查询语句应该怎么修改？例子里面每个文件都是2009年7月5日到11日，但是实际文件中，每个数据库的日期范围都是不一样的，那么怎样对每个数据库都提取每一天的15点到17点呢？

麻烦了，多谢！！

zhaogang1960

telescope 发表于 2014-12-9 15:05
谢谢大神指导！还想补充请教一下：现在数据库里的日期和时间保存成DD/MM/YYYY HH:MM:SS格式，并没有分开日 ...

抱歉，我阅读困难，没有理解，请上传附件并模拟效果说明

telescope

zhaogang1960 发表于 2014-12-9 15:11
抱歉，我阅读困难，没有理解，请上传附件并模拟效果说明

已经解决这个问题了。前面的问题在您的帮助下也完美解决！！非常感谢！！！

LMY123

SQL = SQL & "SELECT GmtDtTm,SpeedKmHr,ACC,FlagDown FROM [MS Access;pwd=;Database=" & MyPath & myName & ";].Week2 WHERE (((GmtDtTm) Between #5/7/2009 10:0:0# And #7/7/2009 15:0:0#) AND ((ACC)=1) AND ((FlagDown)=1))"
多库查询