Excel VBA:从文件夹中的文件中提取数据的宏,跳过已处理的文件
我调整了在互联网上找到的代码,从文件夹中的文件中提取数据,并将它们放在一张母版纸中 但是,文件的数量每周都会快速增长,因此,出于这个原因,我希望在代码中实现宏将跳过已处理的文件。我想通过在母版图纸(U列)中查找文件名来完成 请查找以下代码:Excel VBA:从文件夹中的文件中提取数据的宏,跳过已处理的文件,vba,excel,macros,Vba,Excel,Macros,我调整了在互联网上找到的代码,从文件夹中的文件中提取数据,并将它们放在一张母版纸中 但是,文件的数量每周都会快速增长,因此,出于这个原因,我希望在代码中实现宏将跳过已处理的文件。我想通过在母版图纸(U列)中查找文件名来完成 请查找以下代码: Option Explicit Const FOLDER_PATH = "Z:\...\...\...\" 'REMEMBER END BACKSLASH Sub ImportWorksheets() '===================
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知之甚少,我不知道如何实际表达它,跳过那些已经在母版纸中的文件名
提前谢谢 我现在假设
U
列中的文件名是具有文件扩展名的整个路径。i、 e.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
。要做到这一点。我现在假设U列中的文件名是具有文件扩展名的整个路径。i、 e.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
。这样做