PIECE OF CAKE - MS Excel - Zipando - Escolha uma Pasta e Compacte Tudo Nela - Browse to a folder and zip all files in it

Bem, o título já descreve bem a ação deste código.

Sub Zip_All_Files_in_Folder_Browse()
    Dim FileNameZip, FolderName, oFolder
    Dim strDate As String, DefPath As String
    Dim oApp As Object

    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

    Set oApp = CreateObject("Shell.Application")

    'Browse to the folder
    Set oFolder = oApp.BrowseForFolder(0, "Select folder to Zip", 512)
    If Not oFolder Is Nothing Then
        'Create empty Zip File
        NewZip (FileNameZip)

        FolderName = oFolder.Self.Path
        If Right(FolderName, 1) <> "\" Then
            FolderName = FolderName & "\"
        End If

        'Copy the files to the compressed folder
        oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items

        'Keep script waiting until Compressing is done
        On Error Resume Next
        Do Until oApp.Namespace(FileNameZip).items.Count = _
        oApp.Namespace(FolderName).items.Count
            Application.Wait (Now + TimeValue("0:00:01"))
        Loop
        On Error GoTo 0

        MsgBox "You find the zipfile here: " & FileNameZip

    End If
End Sub

#A&A #PIECEOFCAKE #POC #VBA #RondeBruin #MS #Excel

Veja também:

• MS Excel - Zipando - Abra uma Janela e Escolha os Arquivos que deseja Compacatar
• MS Excel - Zipando - Escolha uma Pasta e Compacte Tudo Nela
• MS Excel - Zipando - Compacte Todos os Arquivos Contidos na Pasta Informada no Código
• MS Excel - Zipando - Compactando a Planilha Atual
• MS Excel - Zipando - Compactando e Enviando por e-Mail

Consulte-nos

⬛◼◾▪ Social Media ▪◾◼⬛

• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 

• VBA Specialist® • VBA Excel Specialist®

• VBA Access Specialist® • VBA Dashboards Specialist®

• VBA Infografics Specialist® • VBA Pharma Specialist® 

⬛◼◾▪ CONTATO ▪◾◼⬛

brazilsalesforceeffectiveness@gmail.com