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 文件,并保持文件夹结构。我尝试在两行标记中进行复制,但收到不同的错误,有什么想法吗?