Jak rychle zkomprimovat všechny e-maily ve složce aplikace Outlook do a Zip Soubor

Někteří uživatelé by chtěli komprimovat všechny e-maily ve složce aplikace Outlook do souboru a zip soubor. Ačkoli taková přímá funkce neexistuje, můžete použít kód VBA uvedený v tomto článku, abyste ji rychle realizovali.

Na zip všechny e-maily ve složce Outlooku, musíte je nejprve jeden po druhém exportovat na místní disk a poté použít funkci „Odeslat do“ > „Komprimovaná (zipovaná) složka“. Tento způsob je nepochybně příliš zdlouhavý. Abychom vám to pomohli zvládnout najednou, v následujícím textu vás naučíme další metodu. Naučíme vás, jak k tomu získat přístup pomocí kódu VBA. Pokud nejste s VBA obeznámeni, můžete se podívat na „Jak spustit kód VBA ve vašem Outlooku" mezitím.

Zkomprimujte všechny e-maily ve složce do a Zip Soubor

1. Pro začátek spusťte editor VBA v Outlooku pomocí kláves „Alt + F11“.
2. Potom zkopírujte a vložte kód VBA do modulu.

Sub ZipAllEmailsInAFolder()
    Dim objFolder As Outlook.Folder
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim strSubject As String
    Dim varTempFolder As Variant
    Dim varZipFile As Variant
    Dim objShell As Object
    Dim objFileSystem As Object
   
    'Select an Outlook Folder
    Set objFolder = Outlook.Application.Session.PickFolder
 
    If Not (objFolder Is Nothing) Then
       'Create a temp folder
       varTempFolder = "E:\" & objFolder.Name & Format(Now, "YYMMDDHHMMSS")
       MkDir (varTempFolder)
       varTempFolder = varTempFolder & "\"
   
       'Save each email as msg file
       For Each objItem In objFolder.Items
 
           If TypeOf objItem Is MailItem Then
              Set objMail = objItem
              strSubject = objMail.Subject
              strSubject = Replace(strSubject, "/", " ")
              strSubject = Replace(strSubject, "\", " ")
              strSubject = Replace(strSubject, ":", "")
              strSubject = Replace(strSubject, "?", " ")
              strSubject = Replace(strSubject, Chr(34), " ")
 
              objMail.SaveAs varTempFolder & strSubject & ".msg", olMSG
           End If
       Next
 
       'Create a new ZIP file
       varZipFile = "E:\" & objFolder.Name & " Emails.zip"
       Open varZipFile For Output As #1
       Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
       Close #1
 
       'Add the exported msg files to the ZIP file
       Set objShell = CreateObject("Shell.Application")
       objShell.NameSpace(varZipFile).CopyHere objShell.NameSpace(varTempFolder).Items

       On Error Resume Next
       Do Until objShell.NameSpace(varZipFile).Items.Count = objShell.NameSpace(varTempFolder).Items.Count
          Application.Wait (Now + TimeValue("0:00:01"))
       Loop
       On Error GoTo 0
 
       'Delete the temp folder
       Set objFileSystem = CreateObject("Scripting.FileSystemObject")
       objFileSystem.DeleteFolder Left(varTempFolder, Len(varTempFolder) - 1)
    End If
End Sub

3. Poté kliknutím na tlačítko „F5“ spusťte toto makro.
4. Později ve vyskakovacím dialogovém okně vyberte zdrojovou složku aplikace Outlook a klikněte na „OK“.
5. Po dokončení makra se zobrazí složka Windows, ve které je nová zip soubor, který obsahuje všechny e-maily z vybrané složky aplikace Outlook, jak je znázorněno na následujícím obrázku.

Zvládněte problémové poškození souborů aplikace Outlook

Mezi všemi běžnými problémy v Outlooku je bezpochyby nejzávažnější poškození Outlooku. Ve skutečnosti se však takové problémy mohou objevit kdykoli. Pokud tedy pravidelně používáte Outlook, měli byste si pravidelně zálohovat data Outlooku. Navíc je rozumné pořídit si robustní zálohu. Oprava aplikace Outlook nástroj, jako je DataNumen Outlook Repair.

Úvod autora:

Shirley Zhang je expertem na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně oprava sql a výhledové softwarové produkty pro opravy. Pro více informací navštivte www.datanumen.com