复制所有非 zip 文件,保持文件夹结构

复制所有非 zip 文件,保持文件夹结构
Sub Copy_Folder()


    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim fil As File
    Dim destfolder As Object
    Dim fsoC As FileSystemObject
    Set fsoC = New FileSystemObject
    Dim filpath As String

    With Application.FileDialog(msoFileDialogFolderPicker) 'Choosing FromPath
        .Show
        FromPath = .SelectedItems(1) & "\"
    End With

    With Application.FileDialog(msoFileDialogFolderPicker) 'Choosing ToPath
        .Show
        ToPath = .SelectedItems(1) & "\"
    End With


   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.GetFolder(FromPath)
   Set destfolder = objFSO.GetFolder(ToPath)
   For Each objSubFolder In objFolder.SubFolders
        Set fils = fsoC.GetFolder(objSubFolder & "\").Files


        For Each fil In fils
            If LCase(Right(fil.Name, 3)) = "zip" Then
                MsgBox "it's a zip file "
            Else
                If Right(FromPath, 1) = "\" Then
                    FromPath = Left(FromPath, Len(FromPath) - 1)
                End If

                If Right(ToPath, 1) = "\" Then
                    ToPath = Left(ToPath, Len(ToPath) - 1)
                End If

                Set FSO = CreateObject("scripting.filesystemobject")

                If FSO.FolderExists(FromPath) = False Then
                    MsgBox FromPath & " doesn't exist"
                    Exit Sub
                End If
             **fil.Copy (ToPath)


                **'FSO.CopyFile Source:=filpath, Destination:=ToPath****

            End If
        Next fil
    Next objSubFolder




    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

End Sub

我想复制所有非 zip 文件,并保持文件夹结构。我尝试在两行标记中进行复制,但收到不同的错误,有什么想法吗?

相关内容