跟踪 Excel 个已处理的文件 VBA

Question

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

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

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

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

下面是我建的宏：

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"作品sheet是编译所有信息的主文件，"Macro Controls"作品sheet包含已经编译的文件列表进行了手术。

我怎样才能加快速度？

Answer 1

你的进程太慢了，因为你每次都在你的控件 sheet 中循环遍历每个文件名。太疯狂了。

尝试这样的事情：

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 语句，只有在真正的紧急情况下才应使用它。

跟踪 Excel 个已处理的文件 VBA

Keeping Track of Excel Files Which Have Already been Processed VBA

vba

excel

file-processing