Kako automatski izdvojiti ugrađene slike iz određenih dolaznih e-poruka putem Outlook VBA

Ako želite da Outlook automatski izdvaja i sprema ugrađene slike iz određenih dolaznih e-poruka, možete pogledati ovaj članak. Ovdje ćemo vas naučiti kako to realizirati pomoću VBA koda.

Neki korisnici često moraju izdvojiti ugrađene slike iz određenih dolaznih e-poruka i sačuvati ih u određenom Windows folderu. Toliko je problematično to učiniti svaki put ručno. Stoga se mnogi raduju učenju brzog i praktičnog pristupa kako bi Outlook to automatski postigao. Sada ćemo sa vama podijeliti takvu metodu.

Automatsko izdvajanje ugrađenih slika iz određenih dolaznih e-poruka

1. Prvo pokrenite svoj Outlook program kao i obično.
2. Zatim pokrenite Outlook VBA editor kao i obično s referencom t “Kako pokrenuti VBA kod u vašem Outlooku".
3. Kasnije kopirajte i zalijepite sljedeći VBA kod u projekt “ThisOutlookSession”.

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. Nakon toga, kliknite na potprogram "Application_Startup".
5. Na kraju, kliknite na tipku “F5” da pokrenete ovaj makro.
6. Od sada, svaki put kada određena nova e-pošta stigne u prijemno sanduče, ugrađene slike će biti sačuvane u određenom Windows folderu, kao što je prikazano na sledećem snimku ekrana.

Redovno čistite velike priloge

Preporučljivo je redovno čistiti velike priloge iz Outlooka. Cilj je da vaša Outlook datoteka ostane odgovarajuće veličine. Veće Outlook datoteke su podložnije oštećenju. Kao što znate, oštećenje PST-a je prilično teško riješiti. Možda ćete prvo pokušati da ga popravite pomoću alata za popravak inboxa. Međutim, u većini slučajeva to neće uspjeti. Jedino rješenje koje vam preostaje je specijalizirani alat. PST repair alat, kao DataNumen Outlook Repair, ili relevantne profesionalne usluge oporavka.

Uvod za autora:

Shirley Zhang je stručnjak za oporavak podataka DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući mdf fix i Outlook softverski proizvodi za popravku. Za više informacija posjetite www.datanumen.com