求助：如何不打开多个EXCEL文件提取数据存入指定EXCEL文件

terryzj · 发表于 2011-3-5 14:17

如有：文件XXX 文件XXX 文件XXX 文件XXXX ~~~~~一系列不同文件（个数，名称不定），且文件名称不一样，但放在同一个文件夹里，如何自动提取该文件夹内所有文件的指定单元格的数据存入一个指定的统计表格.
要求：提取当前文件路径下book1.xls的sheet1工作表中的a1单元格数据。注：不能打开book.xls文件
我知道用vlookup方法结合文件路径是可以做到的，但是有没有在VBA下用程序的方式来搜索得到呢？

zhaogang1960 · 发表于 2011-3-5 15:26

原帖由 terryzj 于 2011-3-5 14:17 发表
如有：文件XXX 文件XXX 文件XXX 文件XXXX ~~~~~一系列不同文件（个数，名称不定），且文件名称不一样，但放在同一个文件夹里，如何自动提取该文件夹内所有文件的指定单元格的数据存入一个指定的统计表格.
要求 ...

Sub Macro1()
Dim cnn As Object, SQL$, Mypath$, MyFile$, n%
Set cnn = CreateObject("adodb.connection")
Mypath = ThisWorkbook.Path & "\"
MyFile = Dir(Mypath & "*.xls")
Do While MyFile <> ""
      If MyFile <> ThisWorkbook.Name Then
         n = n + 1
         If n = 1 Then
            cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & Mypath & MyFile
            SQL = "select* from [Sheet1$] where Project is not null"
         Else
            SQL = SQL & " union all select * from [Excel 8.0;Database=" & Mypath & MyFile & "].[Sheet1$] where Project is not null"
         End If
      End If
      MyFile = Dir()
Loop
[a1].CurrentRegion.Offset(1).ClearContents
[a2].CopyFromRecordset cnn.Execute(SQL)
cnn.Close
Set cnn = Nothing
End Sub

zhaogang1960 · 发表于 2011-3-5 15:27

附件

notopenexcel.rar (13.71 KB, 下载次数: 483)

terryzj · 发表于 2011-3-5 15:37

十分感谢!
没想到是用到SQL来做
学习Ing

terryzj · 发表于 2011-3-5 15:52

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & Mypath & MyFile
这句话
我的文件夹中即有2007版本的文件.xlsm，又有2003版本的文件.xls
似乎：Microsoft.ACE.OLEDB.12.0才支持.xlsx、.xlsm等2007excel文件
microsoft.jet.oledb.4.0只支持.xls
怎么解决阿？
==========
另外一个问题，我想根据某一个字段查找所需数据，sql语句怎么写？
十分感谢！

zhaogang1960 · 发表于 2011-3-5 16:37

原帖由 terryzj 于 2011-3-5 15:52 发表
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & Mypath & MyFile
这句话
我的文件夹中即有2007版本的文件.xlsm，又有2003版本的文件.xls
似乎：Microsoft.ACE.OLEDB ...

稍加修改就可以了，不要自连接，cnn连接到xls和xlsx文件都可以查询到超过65536行记录(针对xlsx文件)：
Sub Macro1()
Dim cnn As Object, SQL$, Mypath$, MyFile$, n%
Set cnn = CreateObject("adodb.connection")
Mypath = ThisWorkbook.Path & "\"
MyFile = Dir(Mypath & "*.xls*")
Do While MyFile <> ""
'       If MyFile <> ThisWorkbook.Name Then
      If Right(MyFile, 4) <> "xlsm" Then '不查询启用宏的工作簿(xlsm)
         n = n + 1
         If n = 1 Then
            cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & Mypath & MyFile
            SQL = "select* from [Sheet1$] where Project is not null"
         Else
            SQL = SQL & " union all select * from [Excel 12.0;Database=" & Mypath & MyFile & "].[Sheet1$] where Project is not null"
         End If
      End If
      MyFile = Dir()
Loop
[a1].CurrentRegion.Offset(1).ClearContents
[a2].CopyFromRecordset cnn.Execute(SQL)
cnn.Close
Set cnn = Nothing
End Sub

[ 本帖最后由 zhaogang1960 于 2011-3-5 16:42 编辑 ]

zhaogang1960 · 发表于 2011-3-5 16:41

附件
自己设置数据超过65536试试看：

notopenexcel - 副本.rar (151.4 KB, 下载次数: 298)

terryzj · 发表于 2011-3-5 17:10

谢谢!
另外一个问题, 还有一个问题如何根据表中A列字段,查询所需字段,然后返回C列的数据
即A列是查询条件,C列是需要返回的结果
这样的sql语句怎么写啊？

zhaogang1960 · 发表于 2011-3-5 17:13

原帖由 terryzj 于 2011-3-5 17:10 发表
谢谢!
另外一个问题, 还有一个问题如何根据表中A列字段,查询所需字段,然后返回C列的数据
即A列是查询条件,C列是需要返回的结果
这样的sql语句怎么写啊？

不是太理解，请上传附件并详细说明

terryzj · 发表于 2011-3-5 19:26

还有一个问题
我用的是excel2007，vba程序是放在采用启用宏的excel（*.xlsm），用上面的代码，程序没有反应啊？
具体见附件
zhao：can u help me? thkx very much!

		自动登录	找回密码
密码			免费注册

[求助] 求助：如何不打开多个EXCEL文件提取数据存入指定EXCEL文件