Question

我找到了一个成功将1个文件复制到一个特定目录的代码段。然而，我想要拼凑的是将一个文件复制到数百个子目录中的方法。我还发现了以递归方式遍历子文件夹的代码，并允许您对子文件夹中的文件执行操作。当然必须混合使用这两个代码才能将1个文件复制到多个子目录中。如果这不可能，我有一个命令提示符的工作代码。

Sub Copy_Certain_Files_In_Folder()
'This example copy all Excel files from FromPath to ToPath.
'Note: If the files in ToPath already exist it will overwrite
'existing files in this folder

Dim fso As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String

'FromPath = "C:\Users\Ron\Data"  '<< Change
'ToPath = "C:\Users\Ron\Test"    '<< Change

FileExt = "*.pdf"  '<< Change
'You can use *.* for all files or *.doc for Word files

If Right(FromPath, 1) <> "\" Then
    FromPath = FromPath & "\"
End If

Set fso = CreateObject("scripting.filesystemobject")

If fso.FolderExists(FromPath) = False Then
    MsgBox FromPath & " doesn't exist"
    Exit Sub
End If

If fso.FolderExists(ToPath) = False Then
    MsgBox ToPath & " doesn't exist"
    Exit Sub
End If

fso.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath

End Sub

循环浏览子文件夹的代码：

Dim FileSystem As Object
Dim HostFolder As String

HostFolder = "C:\"

Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)

Sub DoFolder(Folder)
Dim SubFolder
For Each SubFolder In Folder.SubFolders
    DoFolder SubFolder
Next
Dim File
For Each File In Folder.Files
    ' Operate on each file
Next
End Sub

欢迎任何建议！

Answer 1

请尝试以下代码：

'*****************************************************
' FUNCTION HEADER: Put_A_File_In_All_Subfolders
'
' Purpose:  Looks for the specified file, and if it exists it
'       puts the file in all subfolders of the target path.
'
' Inputs:
'       blnFirstIteration: True / false for whether this is the first function call
'       strFromPath As String: The path where the file to copy is located.
'       strToPath As String: The path where the destination folder tree exists.
'       strFileToCopy: The filename to copy.
'*****************************************************

Sub Put_A_File_In_All_Subfolders( _
    blnFirstIteration As Boolean, _
    strFromPath As String, _
    strToPath As String, _
    strFileToCopy As String)

Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject

Dim blnEverythingIsValid As Boolean
blnEverythingIsValid = True

'If this is the first run, check to make sure the initial file
'exists at that path, else throw error messages:
If blnFirstIteration Then
    If Right(strFromPath, 1) <> "\" Then
        strFromPath = strFromPath & "\"
    End If

    If fso.FolderExists(strFromPath) = False Then
        MsgBox strFromPath & " doesn't exist"
        blnEverythingIsValid = False
    Else
        If Not fso.FileExists(strFromPath & strFileToCopy) Then
            MsgBox strFileToCopy & " doesn't exist in " & strFromPath
            blnEverythingIsValid = False
        End If
    End If

    If fso.FolderExists(strToPath) = False Then
        MsgBox strToPath & " doesn't exist"
        blnEverythingIsValid = False
    End If
End If

If blnEverythingIsValid Then
    If Right(strToPath, 1) <> "\" Then
        strToPath = strToPath & "\"
    End If

    'Copy the file to the destination folder
    fso.CopyFile (strFromPath & strFileToCopy), strToPath, True

    'Run the sub recursively for each subfolder
    Dim vntSubFolder As Variant
    Dim currentFolder As Scripting.Folder
    Set currentFolder = fso.GetFolder(strToPath)

    'Check to see if there are subfolders
    If currentFolder.SubFolders.Count > 0 Then
        For Each vntSubFolder In currentFolder.SubFolders
            'Dim fsoSubFolder As Scripting.Folder
            'Set fsoSubFolder = currentFolder.SubFolders.item(vntSubFolder)

            Dim strSubFolderPath As String
            strSubFolderPath = vntSubFolder.Path

            Put_A_File_In_All_Subfolders False, strFromPath, strSubFolderPath, strFileToCopy
        Next vntSubFolder
    End If
Else
    Set fso = Nothing
    Exit Sub
End If

Set fso = Nothing
End Sub

您可以使用以下方式调用它：

Put_A_File_In_All_Subfolders True, "C:\PathWithFile\", "C:\RootDestinationFolder", "Filename.ext"

我把它快速捣碎了，所以请在广泛使用之前进行测试...

将1个文件复制到多个子目录中

1 个答案: