Kako automatski izdvojiti ugrađene slike iz određene dolazne e-pošte putem programa Outlook VBA

Ako želite da Outlook automatski izdvaja i sprema ugrađene slike iz određene dolazne e-pošte, 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đene dolazne e-pošte i spremiti ih u određenu Windows mapu. Tako je problematično svaki put to ručno raditi. Stoga se mnogi raduju učenju brzog i praktičnog pristupa koji će Outlooku omogućiti da to automatski postigne. Sada ćemo s vama podijeliti takvu metodu.

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

1. Prvo pokrenite Outlook program kao i obično.
2. Zatim pokrenite Outlook VBA uređivač 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 tipku "F5" da biste pokrenuli ovu makronaredbu.
6. Od sada, svaki put kada određena nova e-pošta stigne u Inbox, ugrađene slike bit će spremljene u određenu Windows mapu, kao što je prikazano na sljedećoj snimci zaslona.

Redovito čistite velike privitke

Preporučljivo je redovito čistiti velike privitke iz Outlooka. Cilj je održati vašu Outlook datoteku odgovarajuće veličine. Veće Outlook datoteke su podložnije oštećenjima. Kao što znate, oštećenje PST-a je prilično teško riješiti. Možda ćete prvo pokušati popraviti to pomoću alata za popravak pristigle pošte. Međutim, u većini slučajeva to neće uspjeti. Jedino rješenje je specijalizirani alat. PST popravak alat, poput DataNumen Outlook Repair, ili relevantne profesionalne usluge oporavka.

Uvod za autora:

Shirley Zhang stručnjakinja je za oporavak podataka u DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući mdf fix i softverske proizvode za popravak Outlooka. Za više informacija posjetite www.datanumen.com