使用 VBA 创建子文件夹并将其复制到另一个目录

Question

我需要将一个目录中是否存在父文件夹与另一个目录进行匹配=>如果是，那么我只需要从父文件夹中复制一个子文件夹及其所有内容，然后=>在另一个目录中的父文件夹，循环。

到目前为止，我已经能够在另一个目录中匹配并创建父文件夹和子文件夹，但在复制其内容方面没有成功。任何帮助将不胜感激。

Sub CreateFolders()

'Declare variables for the main folder and subfolder name

Dim mainFolder As String

Dim subFolder As String

Dim subfolders As Range

'Set the main folder path

mainFolder = ThisWorkbook.Path & "\"

'Loop through each row in the worksheet

For i = 1 To ActiveSheet.UsedRange.Rows.Count

    'Get the main folder name from first cell of the current row

    mainFolder = mainFolder & ActiveSheet.Cells(i, 1).Value

    'Check if the main folder does not exist

    If Len(Dir(mainFolder, vbDirectory)) = 0 Then

    'Create the main folder

    MkDir mainFolder

    End If

    'Get the range of subfolder names from the rest of the cells in the current row

    Set subfolders = ActiveSheet.Range(ActiveSheet.Cells(i, 2), ActiveSheet.Cells(i, ActiveSheet.UsedRange.Columns.Count))

    'Loop through the subfolder names

    For Each cell In subfolders

        'Create subfolder name if the cell has value

        If Not IsEmpty(cell) Then

            subFolder = cell.Value

            'Check if the subfolder does not exist

            If Len(Dir(mainFolder & "\" & subFolder, vbDirectory)) = 0 Then

                'Create the subfolder

                MkDir mainFolder & "\" & subFolder

            End If

        End If

    Next cell

    'Reset main folder path

    mainFolder = ThisWorkbook.Path & "\"

Next i

End Sub

Answer 1

我将使用 VBA 中的 FileSystemObject 来复制子文件夹的内容。在您的代码中调用以下子程序。

Sub CopyAll(fromFolder As String, toFolder As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If FSO.FolderExists(fromFolder) Then
        FSO.GetFolder(toFolder).Copy toFolder
    End If
End Sub