使用 VBA 从子文件夹复制文件

Question

我正在尝试创建一个 vba 宏，它将复制包含多个子文件夹的源文件夹中的所有 excel 文件。 这些文件需要复制到一个目标文件夹中（没有子文件夹）。

到目前为止，我已经设法将包括子文件夹在内的整个文件夹复制到目标文件夹。 如何编辑我的代码，以便它只复制 .xls 文件并粘贴它们而没有子文件夹。

Sub PerformCopy()
==================== call ================================
MkDir "DestinationPath"

CopyFiles "Source Path With All Subfolders" & "\", "DestinationPath" & "\"

==================== Copy sub ===========================
End Sub


Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String)
Dim FSO As Object
Dim FileInFromFolder As Object
Dim FolderInFromFolder As Object
Dim Fdate As Long
Dim intSubFolderStartPos As Long
Dim strFolderName As String

Set FSO = CreateObject("scripting.filesystemobject")
'First loop through files
    For Each FileInFromFolder In FSO.GetFolder(strPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        'If Fdate >= Date - 1 Then
            FileInFromFolder.Copy strTarget
        'end if
    Next

    'Next loop throug folders
    For Each FolderInFromFolder In FSO.GetFolder(strPath).SubFolders
        'intSubFolderStartPos = InStr(1, FolderInFromFolder.Path, strPath)
        'If intSubFolderStartPos = 1 Then

        strFolderName = Right(FolderInFromFolder.PATH, Len(FolderInFromFolder.PATH) - Len(strPath))
        MkDir strTarget & "\" & strFolderName

        CopyFiles FolderInFromFolder.PATH & "\", strTarget & "\" & strFolderName & "\"

    Next 'Folder

End Sub

Answer 1

像下面这样，它使用您的 Folder 循环中的初始循环来遍历每个文件并复制到您的目标文件夹中：

Sub PerformCopy()
'==================== call ================================
'MkDir "DestinationPath"

CopyFiles "Source Path With All Subfolders" & "\", "DestinationPath" & "\"

'==================== Copy sub ===========================
End Sub


Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String)
Dim FSO As Object
Dim FileInFromFolder As Object
Dim FolderInFromFolder As Object
Dim Fdate As Long
Dim intSubFolderStartPos As Long
Dim strFolderName As String

Set FSO = CreateObject("scripting.filesystemobject")
'First loop through files
    For Each FileInFromFolder In FSO.GetFolder(strPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
            FileInFromFolder.Copy strTarget
    Next

    'Next loop throug folders
    For Each FolderInFromFolder In FSO.GetFolder(strPath).SubFolders
            For Each FileInFromFolder In FSO.GetFolder(FolderInFromFolder).Files
                    FileInFromFolder.Copy strTarget
            Next
    Next

End Sub