Ako automaticky extrahovať vložené obrázky z konkrétnych prichádzajúcich e-mailov prostredníctvom aplikácie Outlook VBA

Ak chcete, aby program Outlook automaticky extrahoval a ukladal vložené obrázky z konkrétnych prichádzajúcich e-mailov, môžete si prečítať tento článok. Tu vás naučíme, ako to realizovať pomocou kódu VBA.

Niektorí používatelia často potrebujú extrahovať vložené obrázky z konkrétnych prichádzajúcich e-mailov a uložiť ich do určitého priečinka Windows. Je také nepríjemné zakaždým to robiť manuálne. Preto sa mnohí tešia, že sa naučia rýchly a pohodlný prístup, vďaka ktorému to môže Outlook automaticky dosiahnuť. Teraz sa tu s vami podelíme o takúto metódu.

Automaticky extrahovať vložené obrázky z konkrétnych prichádzajúcich e-mailov

1. Najskôr spustite program Outlook ako obvykle.
2. Potom ako obvykle spustite editor Outlook VBA s odkazom t “Ako spustiť kód VBA v programe Outlook".
3. Neskôr skopírujte a prilepte nasledujúci kód VBA do projektu „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. Potom kliknite na podprogram „Application_Startup“.
5. Nakoniec kliknite na kláves „F5“, aby ste spustili toto makro.
6. Odteraz sa zakaždým, keď do priečinka Doručená pošta dorazí konkrétny nový e-mail, vložené obrázky uložia do konkrétneho priečinka systému Windows, ako je znázornené na nasledujúcej snímke obrazovky.

Veľké prílohy pravidelne čistite

Odporúča sa pravidelne čistiť veľké prílohy z Outlooku. Cieľom je udržať súbor Outlooku v primeranej veľkosti. Väčšie súbory Outlooku sú náchylnejšie na poškodenie. Ako viete, poškodenie PST je dosť ťažké opraviť. Možno sa najprv pokúsite opraviť ho pomocou nástroja na opravu doručenej pošty. Vo väčšine prípadov to však nebude fungovať. Jedinou možnosťou je špecializovaný nástroj. Oprava PST nástroj, ako DataNumen Outlook Repairalebo príslušné profesionálne služby vymáhania.

Úvod autora:

Shirley Zhang je expertkou na obnovu dát v DataNumen, Inc., ktorá je svetovým lídrom v oblasti technológií obnovy dát, vrátane mdf opraviť a výhľadové softvérové ​​produkty na opravu. Pre viac informácií navštívte www.datanumen. S