1
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 (переменная объекта или переменная блока не установлена) в отмеченной строке, и я не понимаю, почему? у кого есть идеи?

0