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
Eu quero copiar todos os arquivos que não são zip mantendo a estrutura das pastas. Eu tentei em duas linhas marcadas fazer a cópia, mas recebeu erros diferentes Alguma idéia?
Tags microsoft-excel vba