循环通过子目录 [英] Loop Through Sub-Dir
问题描述
Sub CheckandSend()昏暗的strfile作为字符串Dim ws As Worksheet'确保定义工作表设置ws = ThisWorkbook.Worksheets("RFQ")表格(零件清单").选择表格("RFQ").选择昏暗的最后一刻lastrow = ActiveSheet.Cells(Rows.Count,2).End(xlUp).Row范围("A6:E"& lastrow).选择Application.CutCopyMode =假选择复制表格(零件清单").选择单元格选择Selection.PasteSpecial Paste:= xlPasteValues,Operation:= xlNone,SkipBlanks _:= False,转置:= FalseApplication.CutCopyMode =假单元格选择Cells.EntireColumn.AutoFitDim Worksheet2_Name作为字符串WorkRFQ_Name =零件清单";'将其替换为您要导出的第一张工作表的名称设置WorkRFQ = ThisWorkbook.Worksheets(WorkRFQ_Name)昏暗的Write_Directory作为字符串昏暗的WorkRFQ_Path作为字符串Write_Directory ="P:\ CENTRAL PLANNING \ PROJECTS 2020-2021 \ VAM-TARSON \ Newfolder1 \"WorkRFQ_Path = Write_Directory&"\"&WorkRFQ_NameWorkRFQ.ExportAsFixedFormat _类型:= xlTypePDF,_文件名:= WorkRFQ_Path,_质量:= xlQualityStandard,_IncludeDocProperties:=正确,_IgnorePrintAreas:=否,_OpenAfterPublish:=否表格(零件清单").选择列("A:Z").选择选择删除表格("RFQ").选择昏暗的SourcePath作为字符串SourcePath ="I:\ Mechanical \ ExternalProjects \ Cummins Emission Systems \ 35101124 PT Cup Test Rig \ 16 PDF to Vendor \"昏暗的DestPath作为字符串DestPath ="P:\ Central PLANNING \ PROJECTS 2020-2021 \ VAM-TARSON \ Newfolder1 \"昏昏欲睡Dim f作为SearchFolders昏暗的文件类型作为字符串文件类型="*.pdf"艾罗= 7ws.Cells(irow,2)做.vbNullString昏暗的FileName作为字符串FileName = Dir(SourcePath& ws.Cells(irow,2)&"* .pdf"")在FileName<>时执行vbNullStringVBA.FileCopy SourcePath&文件名,DestPath&文件名FileName = Dir()环形irow = irow + 1环形结束子
在这里,此代码可帮助我找到源路径中存在的pdf文件.插入该文件并放在我的迷途中现在我滞后的地方是,在此文件夹后有多个子文件夹的源路径中(我需要pdf格式,到供应商),我想要一个遍历所有子文件夹并找到我的文件并将其放在目标路径中的代码>
我的子文件夹看起来像OP10,OP20,OP30 ..... ETC ...,
以下是一个函数,该函数将在给定起始位置和文件名模式的情况下返回匹配的 file
对象的集合:
<代码>'在给定起始文件夹和文件模式的情况下返回文件对象的集合例如"* .txt"'如果不想检查子文件夹,则为最后一个参数传递False函数FileMatches(startFolder作为字符串,filePattern作为字符串,_可选subFolders为Boolean = True)作为集合Dim fso,fldr,f,subFldr昏暗的colFiles作为新集合'<<所有匹配的文件Dim colSub As New Collection'<<要扫描的文件夹中是否有匹配文件设置fso = CreateObject("scripting.filesystemobject")colSub.Add startFolder'<<添加起始文件夹'在仍然有要扫描的文件夹时循环播放当colSub.Count>0设置fldr = fso.getfolder(colSub(1))colSub.删除1'<<从列表中删除我们正在扫描的文件夹对于fldr.Files中的每个f'在文件夹中获取文件如果文件名像模式,则将其添加到"hits"中收藏如果UCase(f.Name)类似于UCase(filePattern),则colFiles.Add f下一个f如果是子文件夹,则获取子文件夹进行处理?对于fldr.subFolders中的每个subFldrcolSub.Add subFldr.Path'<<将子文件夹添加到列表中进行处理下一个子图万一环形Set FileMatches = colFiles'返回所有匹配的文件结束功能
基于您发布的代码的示例用法:
<代码>将昏暗的SourcePath作为字符串,将DestPath作为字符串昏暗的colFiles作为集合,fSourcePath ="I:\ Mechanical \ ExternalProjects \ Cummins Emission Systems \ 35101124 PT Cup Test Rig \ 16 PDF to Vendor \"DestPath ="P:\ Central PLANNING \ PROJECTS 2020-2021 \ VAM-TARSON \ Newfolder1 \"昏昏欲睡Dim f作为SearchFolders昏暗的文件类型作为字符串文件类型="*.pdf"艾罗= 7ws.Cells(irow,2)做.vbNullString设置colFiles = FileMatches(SourcePath,ws.Cells(irow,2)&"* .pdf")对于colFiles中的每个ff.复制DestPath&f.名字下一个firow = irow + 1环形
Sub CheckandSend()
Dim strfile As String
Dim ws As Worksheet 'make sure to define a sheet
Set ws = ThisWorkbook.Worksheets("RFQ")
Sheets("Part list").Select
Sheets("RFQ").Select
Dim lastrow As Long
lastrow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
Range("A6:E" & lastrow).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Part list").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Dim Worksheet2_Name As String
WorkRFQ_Name = "Part list" ' Replace this with the name of the first sheet you want to export
Set WorkRFQ = ThisWorkbook.Worksheets(WorkRFQ_Name)
Dim Write_Directory As String
Dim WorkRFQ_Path As String
Write_Directory = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\"
WorkRFQ_Path = Write_Directory & "\" & WorkRFQ_Name
WorkRFQ.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=WorkRFQ_Path, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sheets("Part list").Select
Columns("A:Z").Select
Selection.Delete
Sheets("RFQ").Select
Dim SourcePath As String
SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor\"
Dim DestPath As String
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\"
Dim irow As Long
Dim f As SearchFolders
Dim filetype As String
filetype = "*.pdf"
irow = 7
Do While ws.Cells(irow, 2) <> vbNullString
Dim FileName As String
FileName = Dir(SourcePath & ws.Cells(irow, 2) & "*.pdf")
Do While FileName <> vbNullString
VBA.FileCopy SourcePath & FileName, DestPath & FileName
FileName = Dir()
Loop
irow = irow + 1
Loop
end sub
On here, this code is help me to find an pdf file which is present in my sourcepath & plug that file & place in my destpath now where i am lagging is, in my sourcepath (pdf to vendor") after this folder there are multiple sub-folders , i want a code which loop through all sub-folders and find my files and place it in my dest path
my sub folders will be look like OP10, OP20, OP30.....ETC...,
Here's a function which will return a collection of matching file
objects given a starting location and a file name pattern:
'Return a collection of file objects given a starting folder and a file pattern
' e.g. "*.txt"
'Pass False for last parameter if don't want to check subfolders
Function FileMatches(startFolder As String, filePattern As String, _
Optional subFolders As Boolean = True) As Collection
Dim fso, fldr, f, subFldr
Dim colFiles As New Collection '<< all matched files
Dim colSub As New Collection '<< folders to be scanned for matching files
Set fso = CreateObject("scripting.filesystemobject")
colSub.Add startFolder '<< add the starting folder
'loop while there are still folders to be scanned
Do While colSub.Count > 0
Set fldr = fso.getfolder(colSub(1))
colSub.Remove 1 '<< remove the folder we're now scanning from the list
For Each f In fldr.Files 'get files in folder
'if the filename is like the pattern, add to the "hits" collection
If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
Next f
If subFolders Then 'get subfolders for processing?
For Each subFldr In fldr.subFolders
colSub.Add subFldr.Path '<< add subfolder to list for processing
Next subFldr
End If
Loop
Set FileMatches = colFiles 'return all matched files
End Function
Example usage based on your posted code:
Dim SourcePath As String, DestPath As String
Dim colFiles as Collection, f
SourcePath = "I:\Mechanical\ExternalProjects\Cummins Emission Systems\35101124 PT Cup Test Rig\16 PDF to Vendor\"
DestPath = "P:\CENTRAL PLANNING\PROJECTS 2020-2021\VAM-TARSON\Newfolder1\"
Dim irow As Long
Dim f As SearchFolders
Dim filetype As String
filetype = "*.pdf"
irow = 7
Do While ws.Cells(irow, 2) <> vbNullString
Set colFiles = FileMatches(SourcePath, ws.Cells(irow, 2) & "*.pdf")
For Each f in colFiles
f.Copy DestPath & f.Name
Next f
irow = irow + 1
Loop
这篇关于循环通过子目录的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!