So extrahieren Sie eingebettete Bilder automatisch aus bestimmten eingehenden E-Mails über Outlook VBA

Jetzt teilen:

Wenn Sie möchten, dass Outlook die eingebetteten Bilder aus bestimmten eingehenden E-Mails automatisch extrahiert und speichert, können Sie diesen Artikel lesen. Hier zeigen wir Ihnen, wie Sie dies mit VBA-Code realisieren.

Einige Benutzer müssen häufig die eingebetteten Bilder aus bestimmten eingehenden E-Mails extrahieren und in einem bestimmten Windows-Ordner speichern. Es ist so mühsam, dies jedes Mal manuell zu tun. Daher freuen sich viele darauf, einen schnellen und bequemen Ansatz zu erlernen, mit dem Outlook dies automatisch erledigen kann. Hier teilen wir nun eine solche Methode mit Ihnen.

Automatisches Extrahieren eingebetteter Bilder aus bestimmten eingehenden E-Mails

  1. Starten Sie zunächst Ihr Outlook-Programm wie gewohnt.
  2. Anschließend starten Sie den Outlook VBA Editor wie gewohnt mit dem Verweis t “So führen Sie VBA-Code in Outlook aus".
  3. Kopieren Sie später den folgenden VBA-Code und fügen Sie ihn in das Projekt „ThisOutlookSession“ ein.
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

VBA-Code – Automatisches Extrahieren eingebetteter Bilder aus bestimmten eingehenden E-Mails

  1. Klicken Sie anschließend auf die Unterroutine „Application_Startup“.
  2. Klicken Sie abschließend auf die Taste „F5“, um dieses Makro auszulösen.
  3. Von nun an werden jedes Mal, wenn eine bestimmte neue E-Mail im Posteingang eintrifft, die eingebetteten Bilder im entsprechenden Windows-Ordner gespeichert, wie im folgenden Screenshot gezeigt.Extrahierte Bilder im Windows-Ordner

Große Anhänge regelmäßig bereinigen

Es empfiehlt sich, große Anhänge regelmäßig aus Ihrem Outlook-Konto zu entfernen. Dadurch bleibt Ihre Outlook-Datei auf einer angemessenen Größe. Große Outlook-Dateien sind anfälliger für Beschädigungen. Wie Sie wissen, ist die Behebung von PST-Beschädigungen recht schwierig. Möglicherweise versuchen Sie zunächst, das Problem mit einem Posteingangsreparaturtool zu beheben. In den meisten Fällen ist dies jedoch nicht erfolgreich. Ihre einzige Möglichkeit ist ein spezialisiertes Reparaturtool. PST-Reparatur Werkzeug, wie DataNumen Outlook Repairoder entsprechende professionelle Wiederherstellungsdienste.

Einführung des Autors:

Shirley Zhang ist eine Datenrettungsexpertin in DataNumen, Inc., das weltweit führend bei Datenwiederherstellungstechnologien ist, einschließlich mdf-fix und Outlook-Reparatursoftwareprodukte. Für weitere Informationen besuchen Sie www.datanumen.com €XNUMX

Jetzt teilen:

Kommentare sind geschlossen.