Kuinka sulautetut kuvat puretaan automaattisesti tietyistä saapuvista sähköposteista Outlook VBA: n kautta

Jos haluat, että Outlook purkaa ja tallentaa sulautetut kuvat automaattisesti tietyistä saapuvista sähköposteista, voit viitata tähän artikkeliin. Täällä opetamme, kuinka toteuttaa se VBA-koodilla.

Joidenkin käyttäjien on usein purettava upotetut kuvat tietyistä saapuvista sähköposteista ja tallennettava ne tiettyyn Windows-kansioon. On niin hankalaa tehdä se manuaalisesti joka kerta. Siksi monet odottavat oppivan nopean ja kätevän lähestymistavan, jonka avulla Outlook pystyy toteuttamaan sen automaattisesti. Nyt täällä jaamme tällaisen menetelmän kanssasi.

Pura upotetut kuvat automaattisesti tietyistä saapuvista sähköposteista

1. Käynnistä ensin Outlook-ohjelma tavalliseen tapaan.
2. Käynnistä sitten Outlook VBA -editori tavalliseen tapaan viitteellä t “Kuinka suorittaa VBA-koodi Outlookissa".
3. Kopioi ja liitä myöhemmin seuraava VBA-koodi ThisOutlookSession-projektiin.

Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
    Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set objInboxItems = objInbox.Items
End Sub

Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Dim strWindowsFolder As String
    Dim i As Long
 
    If TypeOf Item Is MailItem Then
       Set objMail = Item
 
       'Specify the emails as per your needs
       If objMail.Importance = olImportanceHigh Then
          Set objAttachments = objMail.Attachments
 
          'Specify the windows folder
          strWindowsFolder = "E:\" & objMail.Subject & Format(Now, "yymmddhhmmss")
          MkDir (strWindowsFolder)
 
          'Save all embedded images to the folder
          For i = 1 To objAttachments.Count
              Set objAttachment = objAttachments.Item(i)
              If IsEmbedded(objAttachment) = True Then
                 objAttachment.SaveAsFile strWindowsFolder & "\" & objAttachment.FileName
              End If
          Next
      End If
    End If
End Sub

Function IsEmbedded(objCurAttachment As Outlook.Attachment) As Boolean
    Dim objPropertyAccessor As Outlook.PropertyAccessor
    Dim strProperty As String
 
    Set objPropertyAccessor = objCurAttachment.PropertyAccessor
    strProperty = objPropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001E")
 
    If InStr(1, strProperty, "@") > 0 Then
       IsEmbedded = True
    Else
       IsEmbedded = False
    End If
End Function

4. Napsauta sen jälkeen "Application_Startup"-aliohjelmaa.
5. Napsauta lopuksi F5-näppäintä käynnistääksesi tämän makron.
6. Tästä eteenpäin aina, kun tietty uusi sähköposti saapuu Saapuneet-kansioon, upotetut kuvat tallennetaan tiettyyn Windows-kansioon, kuten seuraavassa kuvakaappauksessa näkyy.

Siivoa suuret lisälaitteet säännöllisesti

On suositeltavaa poistaa suuret liitteet Outlookista säännöllisesti. Tämän tarkoituksena on pitää Outlook-tiedostosi sopivassa koossa. Suuremmat Outlook-tiedostot ovat alttiimpia vioittumiselle. Kuten tiedät, PST-vaurioita on melko vaikea käsitellä hyvin. Ehkä kannattaa ensin yrittää korjata ne postilaatikon korjaustyökalulla. Useimmissa tapauksissa se ei kuitenkaan toimi. Ainoa keinosi on erikoistunut... PST-korjaus työkalu, kuten DataNumen Outlook Repairtai asiaankuuluvat ammattimaiset palautuspalvelut.

Tekijän esittely:

Shirley Zhang on tietojen palauttamisen asiantuntija DataNumen, Inc., joka on maailman johtava tietojen palautustekniikoissa, mukaan lukien mdf-korjaus ja Outlookin korjausohjelmistotuotteet. Lisätietoja osoitteessa www.datanumen.com