Jak automaticky extrahovat vložené obrázky z konkrétních příchozích e-mailů pomocí aplikace Outlook VBA

Pokud chcete, aby aplikace Outlook automaticky extrahovala a ukládala vložené obrázky z konkrétních příchozích e-mailů, můžete si přečíst tento článek. Zde vás naučíme, jak to realizovat pomocí kódu VBA.

Někteří uživatelé často potřebují extrahovat vložené obrázky z konkrétních příchozích e-mailů a uložit je do určité složky Windows. Je tak obtížné to pokaždé dělat ručně. Mnoho lidí se proto těší, až se naučí rychlý a pohodlný přístup, který aplikaci Outlook umožní dosáhnout toho automaticky. Nyní s vámi sdílíme takovou metodu.

Automaticky extrahovat vložené obrázky z konkrétních příchozích e-mailů

1. Nejprve spusťte program Outlook jako obvykle.
2. Poté spusťte editor Outlook VBA jako obvykle s odkazem t “Jak spustit kód VBA ve vašem Outlooku".
3. Později zkopírujte a vložte následující 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. Poté klikněte do podprogramu „Application_Startup“.
5. Nakonec spusťte toto makro kliknutím na klávesu „F5“.
6. Od této chvíle, pokaždé, když do Doručené přijde konkrétní nový e-mail, se vložené obrázky uloží do konkrétní složky Windows, jak je znázorněno na následujícím snímku obrazovky.

Velké přílohy pravidelně čistěte

Doporučuje se pravidelně čistit velké přílohy z Outlooku. Cílem je udržet soubor Outlooku v odpovídající velikosti. Větší soubor Outlooku je náchylnější k poškození. Jak víte, poškození PST je poměrně obtížné opravit. Možná se nejprve pokusíte problém opravit pomocí nástroje pro opravu doručené pošty. Ve většině případů to však nebude fungovat. Jedinou možností je specializovaný nástroj. Oprava PST nástroj, jako DataNumen Outlook Repairnebo příslušné profesionální služby vymáhání.

Úvod autora:

Shirley Zhang je expertem na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně mdf opravit a výhledové softwarové produkty pro opravy. Pro více informací navštivte www.datanumen.com