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 işaretli satırda bir hata 91 (Nesne değişkeni veya Blok değişkeni ayarlanmamış) aldım ve nedenini anlamadım? birinin bir fikri mi var?
1
Hangi hat? oApp.Namespace (FileNameFolder) .CopyHere oApp.Namespace (FNAME) .items
—
Raystafarian
evet bu çizgi
—
netanel 7:16
MS forumlarındaki ve hatta ozgrid'deki her şey bu hatayı, nedeninin oldukça değişken olduğunu gösteriyor - çalışmalarının bir kısmını deneyin.
—
Raystafarian