vba 需要从目录中的所有文件中提取数据
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7531526/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Need to pull data from all files in a directory
提问by user960358
Possible Duplicate:
Excel - VBA Question. Need to access data from all excel files in a directory without opening the files
So I need to pull data from multiple files in a directory and paste it into one excel file without having to open the files. Someone was nice enough to provide me with code on how to do that for a single file, now I just need to figure out how to do this for all the files in the directory. This code is for a single cell and I need it for a range. That's not an issue but I just thought I'd mention it as well.
因此，我需要从目录中的多个文件中提取数据并将其粘贴到一个 excel 文件中，而无需打开这些文件。有人很好地为我提供了有关如何对单个文件执行此操作的代码，现在我只需要弄清楚如何对目录中的所有文件执行此操作。此代码用于单个单元格，我需要它用于一个范围。这不是问题，但我只是想我也会提到它。
Dim rngDestinationCell As Range
Dim rngSourceCell As Range
Dim xlsPath As String
Dim xlsFilename As String
Dim sourceSheetName As String
Set rngDestinationCell = Cells(3,1) ' or Range("A3")
Set rngSourceCell = Cells(3,1)
xlsPath = "C:\MyPath"
xlsFilename = "MyBook.xls"
sourceSheetName = "Sheet1"
rngDestinationCell.Formula = "=" _
& "'" & xlsPath & "\[" & xlsFilename & "]" & sourceSheetName & "'!" _
& rngSourceCell.Address
So I'm assuming I have to do some sort of loop to run through all the files but I'm not sure how to do it. If someone can help me with this I'd really really appreciate it.
所以我假设我必须做某种循环来遍历所有文件，但我不知道该怎么做。如果有人能帮我解决这个问题，我真的很感激。
回答by paulsm4
You CAN do this in VBA. And, in this case, you arguably SHOULD.
750 (or even 1000) is NOT excessive. Stop worrying about false economies, per your previous post.
Your basic alogorithm is:
1) Identify the .xls(x) file(s) you need to read 2) Extract the information you need in a loop
There are many different ways to accomplish both 1) and 2).
For example:
你可以在 VBA 中做到这一点。而且，在这种情况下，您可以说应该。
750（甚至 1000）并不过分。根据您之前的帖子，不要担心虚假经济。
你的基本算法是：
1) 确定您需要阅读的 .xls(x) 文件 2) 在循环中提取您需要的信息
有许多不同的方法可以同时完成 1) 和 2)。
例如：
Dim wbList() As String, wbCount As Integer, i As Integer
FolderName = "C:\Foldername"
' create list of workbooks in foldername
wbName = Dir(FolderName & "\" & "*.xls")
While wbName ""
-- get info, per any of the links you've already been given --
Wend
回答by brettdj
While I think this post should have been finished in your first thread, you can use the code below which is derived from the earlier link I provided to consolidate row 2 of each sheet called "loging form" from a folder you can specify (change C:\temp to your path)
虽然我认为这篇文章应该已经在您的第一个线程中完成，但您可以使用下面的代码，该代码源自我提供的较早链接，以从您可以指定的文件夹中合并每个名为“登录表单”的工作表的第 2 行（更改 C :\temp 到您的路径)
The code looks at .xlsso it will work on Excel 2003 files, or Excel 2007/10 files. Dir works on all versions. The code skips any workbooks that don't contain a sheet called "loging form"
该代码查看.xls，因此它适用于 Excel 2003 文件或 Excel 2007/10 文件。Dir 适用于所有版本。该代码跳过任何不包含名为“登录表单”的工作表的工作簿
Lastly the returned rows are consolidated on a new sheet (as values) of the workbook that hosts the code, a new sheet is created each time the code runs
最后，返回的行被合并到托管代码的工作簿的一个新工作表（作为值）上，每次代码运行时都会创建一个新工作表
Sub ConFiles()
Dim Wbname As String
Dim Wb As Workbook
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lngCalc As Long
Dim lngrow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .CalculationState
.Calculation = xlCalculationManual
End With
Set ws1 = ThisWorkbook.Sheets.Add
'change folder path here
FolderName = "C:\temp"
Wbname = Dir(FolderName & "\" & "*.xls*")
'ThisWorkbook.Sheets(1).UsedRange.ClearContents
Do While Len(Wbname) > 0
Set Wb = Workbooks.Open(FolderName & "\" & Wbname)
Set ws = Nothing
On Error Resume Next
'change sheet name here
Set ws = Wb.Sheets("loging form")
On Error GoTo 0
If Not ws Is Nothing Then
lngrow = lngrow + 1
ws.Rows(2).Copy ws1.Cells(lngrow, "A")
End If
Wb.Close False
Wbname = Dir
Loop
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
End With
End Sub
回答by Jean-Fran?ois Corbett
You can do a file search like this:
您可以像这样进行文件搜索：
' Find all .xls files in a directory
Dim ff As FoundFiles
With Application.FileSearch
.LookIn = "C:\MyPath\"
.FileType = msoFileTypeExcelWorkbooks
.Execute
Set ff = .FoundFiles
End With
' ff is now a collection of full paths to all excel files in dir
' But you need the filename separate from the folder path...
' FileSystemObject is a convenient tool to manipulate filenames (and more...)
' Before using it, you need to set a reference to it:
' Tools > References > set tickmark next to Microsoft Scripting Runtime
Dim FSO As Scripting.FileSystemObject
Set FSO = New FileSystemObject
Dim i As Integer
For i = 1 To ff.Count
xlsFilename = FSO.GetFileName(ff.Item(i))
' Do your stuff here...
Next i
As an alternative to Application.FileSearch, you can try using the Dirfunction. Have a look at VBA help for Dir.
作为 的替代方法Application.FileSearch，您可以尝试使用该Dir函数。看看 VBA 帮助Dir.
