vba - 跟踪已处理 VBA 的 Excel 文件

Question

我在子文件夹中有数千个 excel 文件，我需要从中提取数据，并将其全部编译到主表中。这些文件通常会在几个月内每天收到。

我已经建立了一个宏来完成这一切。

我遇到的问题是定期重新运行宏以包含新文件。

我需要一种方法来跟踪哪些文件已经被处理，哪些没有。到目前为止，我的解决方案是使用文件名作为唯一键，并将宏运行的每个文件与保存在第二个工作表上的唯一键列表进行比较。您可以想象，这非常慢，我想知道是否有更好的解决方案。

下面是我构建的宏:

Option Explicit

    Sub PullInspectionData()
        Dim fso, oFolder, oSubfolder, oFile, queue As Collection
        Dim n, i As Long
        Dim wb, mwb As Workbook
        Dim wsb, mws, cws As Worksheet
        Dim DefectCode, Level, LocationComments As String
        Dim PhaseName As String

        'Optimize Macro Speed
          Application.ScreenUpdating = False
          Application.EnableEvents = False
          Application.Calculation = xlCalculationManual
          Application.AskToUpdateLinks = False
          Application.DisplayAlerts = False

        'Creates the collection of files within the subfolder
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set queue = New Collection
        Set mwb = ActiveWorkbook
        Set mws = mwb.Worksheets("Inspection Data")
        Set cws = mwb.Worksheets("Macro Controls")
        RowNumber = Worksheets("Inspection Data").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count + 1
        queue.Add fso.GetFolder("filepath") 'obviously replace
        DoEvents

        Do While queue.Count > 0
            Set oFolder = queue(1)
            queue.Remove 1 'dequeue
            DoEvents


            '...insert any folder processing code here...


            For Each oSubfolder In oFolder.subfolders
                queue.Add oSubfolder 'enqueue
                DoEvents
            Next oSubfolder
            DoEvents
            For Each oFile In oFolder.Files
            On Error Resume Next
            DoEvents


' Operate on each file
'This keeps track of which files have already been processed
                n = Worksheets("MacroControls").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
                For i = 1 To n
                If Cells(i, 1).Value = oFile.Name Then
                GoTo SkipLoop
                DoEvents
                End If
                Next i
                DoEvents

                'Actually begins to Copy Information to the Master File
                Cells(i, 1).Value = oFile.Name
                Set wb = Workbooks.Open(oFile)
                Set wsb = wb.Worksheets("PO Data")
                DoEvents

'file processing code removed for simplicity    

               DoEvents
               wb.Close SaveChanges:=False
               DoEvents
    SkipLoop:
            Next oFile
            DoEvents
        Loop

    'Reset Macro Optimization Settings
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayAlerts = True
        Application.AskToUpdateLinks = True

    End Sub

“Inspection Data”工作表是编译所有信息的主文件，“Macro Controls”工作表包含已经操作过的文件列表。

我怎样才能加快速度？

Answer 1

您的过程是如此缓慢，因为您每次都遍历控制表中的每个文件名。这太疯狂了。

尝试这样的事情:

For Each oFile In oFolder.Files

    If cws.Range("A:A").Find(oFile.Name, lookat:=xlWhole) is Nothing Then

         'process this file

    End If

Next

这种方法的另一个优点是它将消除您的 GoTo 语句，这些语句只应在真正紧急的情况下使用。