Question

我已经使用文件对象编写了一些VBA代码，以进入文件夹，搜索满足特定条件（文件名中包含“ HR”并在指定日期范围内创建）的特定文件（CSV），并复制/粘贴信息从那个文件变成一个主文件。主文件通常是250多个工作簿的汇编。

宏可以正常工作，但是运行大约需要12分钟，这有点多余。我相信它需要花费很长时间才能运行，因为它正在索引其中包含30,000+个文件的文件夹。

我已经在下面复制了我的代码的相关行，如果有人知道我可以进行的任何修改都会减少我的宏的持续时间，我将非常感激。我对VBA和编码一般还比较陌生，因此我正在学习这些东西！谢谢！

Dim FilePath As String
Dim FileName As String
Dim objFSO As FileSystemObject
Dim objFolder As Folder
Dim objFile As file
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date

'Defining the user-input variables
Worksheets("Sheet1").Activate
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value

'FilePath to information, defining file objects
FilePath = "\\SRV-1\process\DUMP\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(FilePath)

'Going through Dump folder and finding high resolution files created within the date range
    For Each objFile In objFolder.Files

        'Checking to see if the file contains the string "HR", indicating high resolution.
        If InStr(1, objFile.Name, "HR") Then GoTo Line1 Else GoTo Line3

Line1:
        'Storing the file as a variable and checking its creation date
        FileName = objFile.Name
        OpenFile = FilePath & FileName
        fileDate = FileDateTime(OpenFile)

        'Checking to see if the file was created between the user input master roll start/end dates
        If firstDate < fileDate And secondDate > fileDate Then GoTo Line2 Else GoTo Line3

Line2:
    Do stuff: open dump workbook, copy/pase certain range into main workbook, close dump workbook, next objFile

Line3:
    Next objFile

Answer 1

看看Power Query-这是Microsoft插件，适用于Excel 2012和2013版本，内置于2016年。设置PQ可以非常快地完成操作，并且“脚本”可重复使用！不需要VBA。

您可以按照指定的条件搜索和合并多个文件，但是也可以合并或追加到新文件/主文件。为了提高效率，而不是单独处理每个文件，我建议您（根据您的条件）收集所有数据文件，将它们组合到一个表中，然后使用新表合并/追加到新文件/主文件中

希望这对您有帮助...

Answer 2

考虑到HR文件与总文件的比率（250 / 30,000），这应该显示出一些改善。

使用`Dir`函数，最大程度地减少对`FileSystemObject`的依赖

这里的想法是首先使用Dir函数来获取包含“ HR”子字符串的所有文件名的列表，而仅对这些文件使用FileSystemObject以获取时间戳信息-该目录中的每个文件上的FSO开销是没有用的。

然后，我们仅处理符合“ HR”标准的文件：

Sub usingDir()
Dim folderPath As String
Dim fileName As String
Dim filesToProcess As New Collection
Dim item As Variant
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date

'Defining the user-input variables
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
folderPath = "\\SRV-1\process\DUMP\"

' Gets a collection of files matching the "HR" criteria
fileName = Dir(folderPath)
Do While Not fileName = ""
    If InStr(fileName, "HR") > 0 Then
        'Only processing files with "HR"
        filesToProcess.Add (folderPath & fileName)
    End If
    fileName = Dir
Loop

'Now we deal only with the "HR" files:
With CreateObject("Scripting.FileSystemObject")
    For Each item In filesToProcess
        ' Check the date last modified
        fileDate = .GetFile(item).DateLastModified ' modify as needed
        If firstDate < fileDate And secondDate > fileDate Then
            '
            '
            Debug.Print item
            'your code to Do Stuff goes here
            '
            '
            '
        End If
    Next
End With
End Sub

更新：不使用`FileSystemObject`

这让我很烦，我认为必须有一种方法来获取时间戳信息，而无需依靠FileSystemObject。有。我们仍将使用Dir遍历文件，但是现在我们将消除对FileSystemObject的任何引用，并替换为一些精美的WinAPI函数调用。请查看Chip Pearson的文章here，然后下载.bas modules。您需要将以下两个文件导入到VBProject中：

modGetSetFileTimes
modTimeConversionFunctions

然后您可以执行以下操作：

Option Explicit
Sub withoutFSO()
Dim folderPath As String
Dim FileName As String
Dim filesToProcess As New Collection
Dim item As Variant
Dim fileDate As Date
Dim firstDate As Date
Dim secondDate As Date

'Defining the user-input variables
firstDate = Cells(2, "E").Value
secondDate = Cells(3, "E").Value
folderPath = "\\Your\Path"

' Gets a collection of files matching the "HR" criteria and our Date range
FileName = Dir(folderPath)
Do While Not FileName = ""
    'Only processing files with "HR"
    If InStr(FileName, "HR") > 0 Then
        ' Only process files that meet our date criteria
        fileDate = CDate(modGetSetFileTimes.GetFileDateTime(CStr(item), FileDateLastModified))
        If firstDate < fileDate And secondDate > fileDate Then
            filesToProcess.Add (folderPath & FileName)
        End If
    End If
    FileName = Dir
Loop

'Now we deal only with the matching files:
For Each item In filesToProcess
    Debug.Print item
    Debug.Print fileDate
    'your code to Do Stuff goes here
    '
    '
    '
Next
End Sub

即使是我最初的回答，这也应该是一个改进，并且，如果结合使用更有效的数据检索方式（例如，如果可能的话，使用ADO代替Workbooks.Open），那么您应该非常优化。 / p>

Answer 3

除了使用n函数代替Dir之外，如果您无法自动执行PowerQuery，并且您所需要的只是数据而不是格式，请考虑直接与源工作簿建立数据连接使用ADODB。

添加对 Microsoft ActiveX数据对象6.1库的引用（通过工具-> 参考... ）。可能有6.1以外的版本；选择最高的。

然后，您可以使用类似以下代码的内容：

FileSystemObject

Answer 4

花了很长时间，因为对于每次交互，您都将信息传递到主工作表。

在这种情况下，最好使用多维数组来保留信息，并在过程结束时在主工作表中传递数组信息。

我不知道您在每个工作表中会获得什么信息，因此无法为您创建一个生动的示例。

如何（有条件地）比使用FileSystemObject更快地遍历文件

4 个答案:

使用`Dir`函数，最大程度地减少对`FileSystemObject`的依赖

更新：不使用`FileSystemObject`

如何（有条件地）比使用FileSystemObject更快地遍历文件

4 个答案:

使用Dir函数，最大程度地减少对FileSystemObject的依赖

更新：不使用FileSystemObject

使用`Dir`函数，最大程度地减少对`FileSystemObject`的依赖

更新：不使用`FileSystemObject`