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, сохраняя структуру папок. Я попытался в двух отмеченных строках сделать копию, но получил разные ошибки. Есть идеи?

0