Excel VBA：宏从文件夹中的文件中提取数据并跳过已处理的文件

Question

我调整了我在互联网上找到的代码，从文件夹中的文件中提取数据并将它们放在一个主表中。

但是，文件数量每周都会快速增长，因此我想在代码中实现宏将跳过已处理的文件。我想通过在主表（U 列）中查找文件名来做到这一点。

请在下面找到代码：

Option Explicit


Const FOLDER_PATH = "Z:\...\...\...\"  'REMEMBER END BACKSLASH


Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim fName As String
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long         'output row
   Dim wsMaster As Worksheet
   Dim NR As Long
   rowTarget = 3

   'Setup
    Application.ScreenUpdating = False  'speed up macro execution
    Application.EnableEvents = False    'turn off other macros for now
    Application.DisplayAlerts = False   'turn off system messages for now

    Set wsMaster = ThisWorkbook.Sheets("Arkusz1")    'sheet report is built into

With wsMaster
    If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
        .UsedRange.Offset(2).Columns(3).Clear
        .UsedRange.Offset(2).Columns(4).Clear
        .UsedRange.Offset(2).Columns(5).Clear
        .UsedRange.Offset(2).Columns(6).Clear
        .UsedRange.Offset(2).Columns(7).Clear
        .UsedRange.Offset(2).Columns(8).Clear
        .UsedRange.Offset(2).Columns(9).Clear
        .UsedRange.Offset(2).Columns(10).Clear
        .UsedRange.Offset(2).Columns(11).Clear
        .UsedRange.Offset(2).Columns(12).Clear
        .UsedRange.Offset(2).Columns(13).Clear
        .UsedRange.Offset(2).Columns(14).Clear
        .UsedRange.Offset(2).Columns(15).Clear
        .UsedRange.Offset(2).Columns(17).Clear
        .UsedRange.Offset(2).Columns(18).Clear
        .UsedRange.Offset(2).Columns(20).Clear
        NR = 3

    Else
        NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1    'appends data to existing data
    End If

   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If

   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False

   'set up the target worksheet
   Set wsTarget = Sheets("Arkusz1")

   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xls*")
   Do Until sFile = ""

      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(3) 'EDIT IF NECESSARY

      'import the data
      With wsTarget
         .Range("C" & rowTarget).Value = wsSource.Range("F4").Value
         .Range("D" & rowTarget).Value = wsSource.Range("J4").Value
         .Range("E" & rowTarget).Value = wsSource.Range("J7").Value
         .Range("F" & rowTarget).Value = wsSource.Range("J10").Value
         .Range("G" & rowTarget).Value = wsSource.Range("J19").Value
         .Range("H" & rowTarget).Value = wsSource.Range("L19").Value
         .Range("I" & rowTarget).Value = wsSource.Range("H17").Value
         .Range("J" & rowTarget).Value = wsSource.Range("N27").Value
         .Range("K" & rowTarget).Value = wsSource.Range("N29").Value
         .Range("L" & rowTarget).Value = wsSource.Range("N36").Value
         .Range("M" & rowTarget).Value = wsSource.Range("N38").Value
         .Range("N" & rowTarget).Value = wsSource.Range("J50").Value
         .Range("O" & rowTarget).Value = wsSource.Range("L50").Value
         .Range("Q" & rowTarget).Value = wsSource.Range("J52").Value
         .Range("R" & rowTarget).Value = wsSource.Range("L52").Value
         .Range("T" & rowTarget).Value = wsSource.Range("N57").Value

         'optional source filename in the last column
         .Range("U" & rowTarget).Value = sFile
      End With

      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
   End If

   'Format columns to the desired format
   .UsedRange.Offset(2).Columns(7).NumberFormat = "### ### ##0"
   .UsedRange.Offset(2).Columns(8).NumberFormat = "### ### ##0"
   .UsedRange.Offset(2).Columns(9).NumberFormat = "#,##0.00 $"
   .UsedRange.Offset(2).Columns(10).NumberFormat = "#,##0.00 $"
   .UsedRange.Offset(2).Columns(11).NumberFormat = "#,##0.00 $"
   .UsedRange.Offset(2).Columns(12).NumberFormat = "#,##0.00 $"
   .UsedRange.Offset(2).Columns(13).NumberFormat = "#,##0.00 $"
   .UsedRange.Offset(2).Columns(14).NumberFormat = "0.00%"
   .UsedRange.Offset(2).Columns(15).NumberFormat = "0.00%"
   .UsedRange.Offset(2).Columns(16).NumberFormat = "0.00%"
   .UsedRange.Offset(2).Columns(17).NumberFormat = "0.00%"
   .UsedRange.Offset(2).Columns(18).NumberFormat = "0.00%"
   .UsedRange.Offset(2).Columns(19).NumberFormat = "0.00%"
   .UsedRange.Offset(2).Columns(20).NumberFormat = "0.00%"

errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True

   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End With
End Sub




Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

我试图通过 If 和 GoTo 语句来实现它，但我对 VBA 知之甚少，我不知道如何实际制定它跳过名称已经在主表中的文件。

提前致谢！

Answer 1

我暂时假设U 列中的文件名是带有文件扩展名的整个路径。即C:\Users\SL\Desktop\TestFile.xls

您可以使用Find 方法在每个循环开始时查找U 列中与sFile 匹配的任何条目。如果找到匹配项，则跳过文件并继续，否则处理它。确保将sFile = Dir() 放在If 语句之外以避免无限循环。

Dim PathMatch As Range

'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")

Do Until sFile = ""
    With wsMaster.Range("U:U")
        Set PathMatch = .Find(What:=sFile, _
                                    After:=.Cells(.Cells.Count), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False)
    End With

    If Not PathMatch Is Nothing Then
        Debug.Print "File already processed, skip to next file."
    Else
        Debug.Print "File not processed yet, do it now"

        'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
        Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
        Set wsSource = wbSource.Worksheets(3) 'EDIT IF NECESSARY

        'import the data
        With wsTarget
           .Range("C" & rowTarget).Value = wsSource.Range("F4").Value
           .Range("D" & rowTarget).Value = wsSource.Range("J4").Value
           .Range("E" & rowTarget).Value = wsSource.Range("J7").Value
           .Range("F" & rowTarget).Value = wsSource.Range("J10").Value
           .Range("G" & rowTarget).Value = wsSource.Range("J19").Value
           .Range("H" & rowTarget).Value = wsSource.Range("L19").Value
           .Range("I" & rowTarget).Value = wsSource.Range("H17").Value
           .Range("J" & rowTarget).Value = wsSource.Range("N27").Value
           .Range("K" & rowTarget).Value = wsSource.Range("N29").Value
           .Range("L" & rowTarget).Value = wsSource.Range("N36").Value
           .Range("M" & rowTarget).Value = wsSource.Range("N38").Value
           .Range("N" & rowTarget).Value = wsSource.Range("J50").Value
           .Range("O" & rowTarget).Value = wsSource.Range("L50").Value
           .Range("Q" & rowTarget).Value = wsSource.Range("J52").Value
           .Range("R" & rowTarget).Value = wsSource.Range("L52").Value
           .Range("T" & rowTarget).Value = wsSource.Range("N57").Value

           'optional source filename in the last column
           .Range("U" & rowTarget).Value = sFile
        End With

        'close the source workbook, increment the output row and get the next file
        wbSource.Close SaveChanges:=False
        rowTarget = rowTarget + 1
    End If
    sFile = Dir()
Loop

---

如果您只有文件名而不是路径，则需要相应地解析 sFile。 Here are a few ways 这样做。