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