Question

可能重复：
Excel - VBA Question. Need to access data from all excel files in a directory without opening the files

所以我需要从目录中的多个文件中提取数据并将其粘贴到一个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

所以我假设我必须做一些循环来运行所有文件，但我不知道该怎么做。如果有人可以帮助我，我真的很感激。

Answer 1

您可以在VBA中执行此操作。而且，在这种情况下，你可以说是应该。
750（甚至1000）并不过分。根据{{3}}。
你的基本算法是：

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

Answer 2

虽然我认为这篇文章应该在你的第一个帖子中完成，你可以使用下面的代码，该代码来自我提供的早期链接，用于合并每个工作表的第2行，称为“登录表单”，你可以指定一个文件夹（将C：\ temp更改为您的路径）

代码查看 .xls ，因此它可以在Excel 2003文件或Excel 2007/10文件上运行。 Dir适用于所有版本。代码会跳过任何不包含名为“loging form”的工作表的工作簿

最后，返回的行合并在托管代码的工作簿的新工作表（作为值）上，每次代码运行时都会创建一个新工作表

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

Answer 3

您可以像这样进行文件搜索：

' 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

作为Application.FileSearch的替代方案，您可以尝试使用Dir功能。查看Dir的VBA帮助。

需要从目录中的所有文件中提取数据

3 个答案: