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

使用VBA

1 个答案: