PIECE OF CAKE - MS Excel - Zipando - Compacte Todos os Arquivos Contidos na Pasta Informada no Código - Zip all files in the folder that you enter in the code


Antes de executar este código, altere a pasta na linha 
FolderName = "C: \ Bernardes \"



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

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

    FolderName = "C:\Bernardes\"    '<< Change

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

    'Create empty Zip File
    NewZip (FileNameZip)

    Set oApp = CreateObject("Shell.Application")

    '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 Sub



#A&A #PIECEOFCAKE #POC #VBA #RondeBruin #MS #Excel
Consulte-nos

⬛◼◾▪ Social Media ▪◾◼⬛
• FACEBOOK • TWITTER • INSTAGRAM • TUMBLR • GOOGLE+ • LINKEDIN • PINTEREST

⬛◼◾▪ Blogs ▪◾◼⬛ 


⬛◼◾▪ CONTATO ▪

Nenhum comentário:

Postar um comentário

diHITT - Notícias