我想继续以下代码来检查\'destFolderPath\'内的文件夹,并从文件夹名称\'mmmyy\'中提取月份和年份,然后比较文件夹na...
我想继续以下代码来检查 \'destFolderPath\' 内的文件夹,并从文件夹名称 \'mmmyy\' 中提取月份和年份,然后比较文件夹名称以找出哪个文件夹名称是最新的,例如,如果我们有 \'Jul24\' 和 \'May24\',则 \'Jul24\' 将是最新的,然后打开其文件夹并搜索名称为 \'FP Sizing - \'Requestname\' - Temp\' 或 \'FP Resizing - \'Requestname\' - Temp\' 的 excel 文件并将其复制到 \'destFolderPath\' 文件夹中,我尝试了几种方法,但都没有用:
Sub CopyAllFolders(folders As Collection, destFolderPath As String)
Dim fso As Object
Dim folderPath As Variant
Dim folderName As String
Dim monthFolderName As String
Dim yearFolderName As String
Dim typeFolderName As String
Dim newFolderPath As String
' Initialize FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Ensure the destination folder exists
If Dir(destFolderPath, vbDirectory) = "" Then
MkDir destFolderPath
End If
' Loop through each folder in the collection and copy it to the destination folder
For Each folderPath In folders
' Extract the folder name (process folder)
folderName = fso.GetFolder(folderPath).Name
' Extract the month folder name (parent folder name of the current folder)
monthFolderName = fso.GetFolder(fso.GetParentFolderName(folderPath)).Name
' Extract the year folder name (parent of the month folder)
yearFolderName = fso.GetFolder(fso.GetParentFolderName(fso.GetParentFolderName(folderPath))).Name
' Extract the type folder name (parent of the year folder)
typeFolderName = fso.GetFolder(fso.GetParentFolderName(fso.GetParentFolderName(fso.GetParentFolderName(folderPath)))).Name
' Convert monthFolderName from "mmm-yy" to "mmmyy" (e.g., "Sep-23" becomes "0923")
monthFolderName = Format(DateValue("01-" & monthFolderName), "mmmyy")
' Create the new folder path as "typeFolderName mmyy"
newFolderPath = destFolderPath & "\" & typeFolderName & "-" & monthFolderName
' Ensure the new folder exists
If Dir(newFolderPath, vbDirectory) = "" Then
MkDir newFolderPath
End If
' Check if the folder exists before attempting to copy
If fso.FolderExists(folderPath) Then
On Error Resume Next ' Ignore errors during copy operation
fso.CopyFolder source:=folderPath, destination:=newFolderPath, OverwriteFiles:=True
If Err.Number <> 0 Then
MsgBox "Error copying folder: " & folderPath & " to " & newFolderPath & vbCrLf & "Error: " & Err.Description
Err.Clear
End If
On Error GoTo 0 ' Resume normal error handling
Else
MsgBox "Source folder does not exist: " & folderPath
End If
Next folderPath
' Clean up
Set fso = Nothing
End Sub