Kako samodejno izvleči vdelane slike iz določenih dohodnih e-poštnih sporočil prek programa Outlook VBA

Če želite, da Outlook samodejno izvleče in shrani vdelane slike iz določenih dohodnih e-poštnih sporočil, se lahko obrnete na ta članek. Tu vas bomo naučili, kako to uresničiti s kodo VBA.

Nekateri uporabniki pogosto morajo vdelane slike izvleči iz določenih dohodnih e-poštnih sporočil in jih shraniti v določeno mapo sistema Windows. To je tako težavno, če to ročno naredite vsakič. Zato se mnogi veselijo, da se bodo naučili hitrega in priročnega pristopa, s pomočjo katerega bo Outlook samodejno dosegel to. Zdaj bomo tukaj delili tak način z vami.

Samodejno izvleči vdelane slike iz določenih dohodnih e-poštnih sporočil

1. Najprej zaženite program Outlook kot običajno.
2. Nato sprožite urejevalnik Outlook VBA kot običajno s sklicem t “Kako zagnati kodo VBA v Outlooku".
3. Kasneje kopirajte in prilepite naslednjo kodo VBA v 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. Po tem kliknite na podprogram »Application_Startup«.
5. Na koncu kliknite tipko “F5”, da sprožite ta makro.
6. Od zdaj naprej se bodo vdelane slike vsakič, ko v mapo »Prejeto« prispe določeno novo e-poštno sporočilo, shranile v določeno mapo Windows, kot je prikazano na naslednjem posnetku zaslona.

Redno čistite velike priključke

Priporočljivo je, da redno čistite velike priloge iz Outlooka. Namen tega je ohraniti vašo Outlookovo datoteko ustrezne velikosti. Večje Outlookove datoteke so bolj dovzetne za poškodbe. Kot veste, je poškodbe PST precej težko dobro odpraviti. Morda boste najprej poskusili popraviti težavo z orodjem za popravilo mape »Prejeto«. Vendar v večini primerov to ne bo delovalo. Vaša edina možnost je specializirano orodje. Popravilo PST orodje, kot DataNumen Outlook Repairali ustrezne poklicne storitve izterjave.

Uvod avtorja:

Shirley Zhang je strokovnjakinja za obnovitev podatkov v DataNumen, Inc., ki je vodilna na svetu na področju tehnologij za obnovitev podatkov, vključno z mdf popravek in obeti za popravilo programskih izdelkov. Za več informacij obiščite www.datanumen.com