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)
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
FSO.CopyFolder Source:=FromPath, Destination:=ToPath
For Each destfolder In destfolder.SubFolders
Set fils = fsoC.GetFolder(destfolder & "\").Files
For Each fil In fils
If LCase(Right(fil.Name, 3)) = "zip" Then
Call unzip2(fil)
'MsgBox "it's a zip file "
Else
End If
Next fil
Next destfolder
MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End Sub
Sub unzip2(FNAME As Variant)
Dim FSO As Object
Dim oApp As Object
'Dim FNAME As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
' Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
' MultiSelect:=False)
If FNAME = False Then
'Do nothing
Else
'Root folder for the new folder.
SlashPosition = InStrRev(FNAME, "\")
DotPosition = InStrRev(FNAME, ".")
DefPath = Left(FNAME, SlashPosition)
FolderName = Mid(FNAME, SlashPosition + 1, DotPosition - SlashPosition - 1)
'Create the folder name
'strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & FolderName & "\"
'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
**oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(FNAME).items**
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.DeleteFolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
我在标记的行上收到错误 91(未设置对象变量或 With 块变量),我不明白为什么?有人有想法吗?