将文件更新到一个文件夹的子文件夹 VBA

Question

我想用excel VBA更新当前子文件夹中的文件。第一步是在子文件夹中查找文件名。将它们全部列在另一张纸中，以便我可以为此保留日志。复制并用新文件覆盖文件，因此我的所有文件夹和子文件夹都将使用新文件更新。

source
D:home
destination
D:destcus1...

我目前正在使用以下代码，但我至少需要改进 for 循环或任何新算法。你能帮忙吗？

Sub sbCopyingAllExcelFiles()
Dim FSO
Dim sFolder As String
Dim dFolder As String
sFolder = "c:UsersosmanercDesktopSTATUS" ' change to match the source folder path
dFolder = "\manfileELEKTRONIKMUSTERI DESTEKECN management" ' change to match the destination folder path
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(sFolder) Then
MsgBox "Source Folder Not Found", vbInformation, "Source Not Found!"
ElseIf Not FSO.FolderExists(dFolder) Then
MsgBox "Destination Folder Not Found", vbInformation, "Destination Not Found!"
Else
FSO.CopyFile (sFolder & "*.xl*"), dFolder
MsgBox "Successfully Copied All Excel Files to Destination", vbInformation, "Done!"
End If
End Sub

Answer 1

因此，这应该能够从源中复制与Like sFolder & "*.xl*"模式匹配的所有文件。如果您有更多文件夹可供使用，则可以添加更多呼叫。

Sub sbCopyingAllExcelFiles()
Call SafeCopy("c:UsersosmanercDesktopSTATUS", "\manfileELEKTRONIKMUSTERI DESTEKECN management")
'Call SafeCopy("another source folder", "another destination folder")
'Add more function calls as necessary
End Sub
Function SafeCopy(ByVal sFolder As String, ByVal dFolder As String)
Dim count As Integer
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(sFolder) Then
MsgBox "Source Folder Not Found: " & vbCrLf & sFolder, vbInformation, "Source Not Found!"
Exit Function
ElseIf Not FSO.FolderExists(dFolder) Then
MsgBox "Destination Folder Not Found: " & vbCrLf & dFolder, vbInformation, "Destination Not Found!"
Exit Function
Else
Set Folder = FSO.GetFolder(sFolder)
For Each File In Folder.Files
If File.Name Like sFolder & "*.xl*" Then
FSO.CopyFile File.path, dFolder
count = count + 1
End If
Next
MsgBox "Copied " & count & "files to destination", vbInformation, "Copy Successful"
End If
End Function