Option Explicit

Private Sub CopyDirectory()

    ' 获取源目录和目标目录路径

    Dim sourcePath As String

    sourcePath = "D:\qita\"

    Dim destPath As String

    destPath = App.Path & "\"

    ' 创建目标目录

    If Not Dir(destPath, vbDirectory) <> "" Then

        MkDir destPath

    End If

    ' 复制所有文件

    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim sourceFolder As Object

    Set sourceFolder = fso.GetFolder(sourcePath)

    Dim destFolder As Object

    Set destFolder = fso.GetFolder(destPath)

    Dim file As Object

    Dim result As Integer

    For Each file In sourceFolder.Files

        On Error Resume Next

        fso.CopyFile file.Path, destFolder.Path & "\" & file.Name, True

        If Err.Number <> 0 Then

            result = -1

            Debug.Print "Failed to copy file: " & file.Name

        Else

            Debug.Print "Copied file: " & file.Name

        End If

        On Error GoTo 0

    Next

    ' 显示操作结果

    If result = -1 Then

        MsgBox "内容复制失败", vbInformation

    Else

        MsgBox "内容全部复制完毕.", vbInformation

    End If

End Sub

Private Sub Command1_Click()

Call CopyDirectory

End Sub

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~下面是将整个文件夹都复制过来得方法

Option Explicit

Private Sub CopyDirectory()

    ' 获取源目录和目标目录路径

    Dim sourcePath As String

    sourcePath = "D:\qita"  '这里最后以为一定不要加\否则提示目录找不到

    Dim destPath As String

    destPath = App.Path

    Dim fso As Object

    ' 创建目标目录

    If Not Dir(destPath, vbDirectory) <> "" Then

        MkDir destPath

    End If

    ' 复制源目录以及其所有子目录和文件

    Set fso = CreateObject("Scripting.FileSystemObject")

    fso.CopyFolder sourcePath, destPath

    ' 显示操作结果

    MsgBox "All files and folders were copied successfully.", vbInformation

End Sub

Private Sub Command1_Click()

Call CopyDirectory

End Sub