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

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

但是，文件的数量将会每周增长很快，所以我想在代码中实现macros将跳过已经处理的文件。 我想通过在主表单（U栏）中查找文件名来完成。

请find下面的代码：

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知之甚less，我不知道如何实际制定它跳过名称已经在主表单中的文件。

提前致谢！

Answer 1

我将假设目前U列中的文件名是带有文件扩展名的整个path。 即C:\Users\SL\Desktop\TestFile.xls

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

 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 

---

如果只有文件名，而不是path，则需要相应地parsingsFile 。 这里有几个方法来做到这一点。