Отслеживание файлов Excel, которые уже были обработаны VBA - PullRequest
Новая
       50

Отслеживание файлов Excel, которые уже были обработаны VBA

0 голосов
/ 27 сентября 2018

У меня есть тысячи файлов 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

Рабочий лист «Данные проверки» - это основной файл, в котором собрана вся информация, а рабочий лист «Элементы управления макросом» содержит списокфайлы, которые уже были обработаны.

Как мне ускорить процесс?

1 Ответ

0 голосов
/ 27 сентября 2018

Ваш процесс очень медленный, потому что вы каждый раз просматриваете каждое имя файла в контрольном листе.Это безумие.

Попробуйте что-то вроде этого: 

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, которые следует использовать только в случае реальной чрезвычайной ситуации.

...