Kõigi Outlooki kaustas olevate meilide kiire tihendamine a Zip Fail

Mõned kasutajad soovivad tihendada kõik Outlooki kaustas olevad meilid kaustasse a zip faili. Kuigi sellist otsest funktsiooni pole, saate selle kiireks realiseerimiseks kasutada selles artiklis avaldatud VBA-koodi.

Et zip Kõik Outlooki kaustas olevad meilid, peate need esmalt ükshaaval eksportima kohalikule draivile ja seejärel kasutama käsku "Saada" > "Tihendatud (zipped) kausta” funktsioon. Kahtlemata on see sel viisil liiga tüütu. Seetõttu, et aidata teil seda korraga realiseerida, õpetame teile järgnevalt teist meetodit. See õpetab teile, kuidas seda VBA-koodiga hankida. Kui te pole VBA-ga tuttav, võite vaadata "Kuidas Outlookis VBA-koodi käivitada" samal ajal.

Tihendage kõik kaustas olevad meilid a Zip Fail

1. Sest nagutart, käivitage Outlook VBA redaktor, kasutades "Alt + F11".
2. Seejärel kopeerige ja kleepige VBA kood moodulisse.

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. Seejärel klõpsake selle makro käivitamiseks klahvi "F5".
4. Hiljem valige hüpikaknas Outlooki lähtekaust ja klõpsake "OK".
5. Kui makro on lõppenud, kuvatakse Windowsi kaust, milles on uus zip faili, mis sisaldab kõiki valitud Outlooki kausta e-kirju, nagu on näidatud järgmisel joonisel.

Käsitlege tülikat Outlooki failikorruptsiooni

Kõigi Outlooki levinud probleemide hulgas on vaieldamatult Outlooki kahju most tõsine. Kuid tegelikkuses võivad sellised probleemid tekkida igal ajal. Seega, kui olete tavaline Outlooki kasutaja, peate Outlooki andmetest regulaarselt varukoopiaid tegema. Lisaks on mõistlik hankida robustne Outlooki parandamine utiliit, näiteks DataNumen Outlook Repair.

Autori sissejuhatus:

Shirley Zhang on andmete taastamise ekspert DataNumen, Inc., mis on maailmas juhtiv andmete taastamise tehnoloogiate, sealhulgas sql parandus ja Outlooki remonditarkvaratooted. Lisateabe saamiseks külastage www.datanumenCom