Guten Morgen zusammen,

ich benutze folgenden Code:

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260


Function BrowseFolder(Optional Caption As String, _
    Optional InitialFolder As String) As String

    Dim SH As Shell32.Shell
    Dim F As Shell32.Folder
    Dim WshShell As Object

    Set SH = New Shell32.Shell
    Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
    Set WshShell = CreateObject("WScript.Shell")

    If Not F Is Nothing Then
        'Spezielle Ordner liefern nicht immer den vollen Pfad zurück, deswegen erfolgt Prüfung des Titels
        Select Case F.Title
            Case "Desktop"
                BrowseFolder = WshShell.SpecialFolders("Desktop")
            Case "My Documents"
                BrowseFolder = WshShell.SpecialFolders("MyDocuments")
            Case "My Computer"
                MsgBox "Invalid selection", vbCritical + vbOKOnly, "Error"
                Exit Function
            Case "My Network Places"
                MsgBox "Invalid selection", vbCritical + vbOKOnly, "Error"
                Exit Function
            Case Else
                BrowseFolder = F.Items.Item.Path
        End Select
   End If
   
   'Cleanup
   Set SH = Nothing
   Set F = Nothing
   Set WshShell = Nothing

End Function

Sub SaveAttachment()
  
     'Alle gewählten Items erfassen
    Set MyOlApplication = CreateObject("Outlook.Application")
    Set MyOlNameSpace = MyOlApplication.GetNamespace("MAPI")
    Set MyOlSelection = MyOlApplication.ActiveExplorer.Selection

    'Sicherstellen, dass überhaupt eine E-Mail ausgewählt ist.
      If MyOlSelection.Count = 0 Then
       Response = MsgBox("Markieren Sie zunächst eine E-Mail.", vbExclamation, MyApplName)
       Exit Sub
    End If
    
    'Sicherstellen, dass nur eine E-Mail ausgewählt ist.
    If MyOlSelection.Count > 1 Then
       Response = MsgBox("Bitte wählen Sie NUR EINE E-Mail.", vbExclamation, MyApplName)
       Exit Sub
    End If
    
    'Rückgabe der ausgewählten E-Mail.
    Set MySelectedItem = MyOlSelection.Item(1)
 
    'Retrieve all attachments from the selected item
    Dim colAttachments As Outlook.Attachments
    Dim objAttachment As Outlook.Attachment
    Set colAttachments = MySelectedItem.Attachments
    
    'Ordnerauswahl durch den Benutzer
    Dim FolderPath As String
    FolderPath = BrowseFolder("Wählen Sie bitte einen vorhandenen Ordner aus oder erstellen Sie einen neuen.")
    If FolderPath = "" Then
        Response = MsgBox("Die Auswahl eines Ordners ist erforderlich. Vorgang abgebrochen.", vbExclamation, MyApplName)
       Exit Sub
    End If
    
    'Speichern aller Anhänge in den gewählten Ordner mit Zeitstempel der Nachricht, um eindeutige Namen zu generieren
    Dim DateStamp As String
    Dim MyFile As String
    For Each objAttachment In colAttachments
        MyFile = objAttachment.FileName
        DateStamp = Format(MySelectedItem.CreationTime, " - yyyymmdd_hhnnss")
        intPos = InStrRev(MyFile, ".")
        If intPos > 0 Then
            MyFile = Left(MyFile, intPos - 1) & DateStamp & Mid(MyFile, intPos)
        Else
            MyFile = MyFile & "DateStamp"
        End If
        
        objAttachment.SaveAsFile (FolderPath & "\" & MyFile)
    Next
    
    'Cleanup
    Set objAttachment = Nothing
    Set colAttachments = Nothing
    Set MyOlApplication = Nothing
    Set MyOlNameSpace = Nothing
    Set MyOlSelection = Nothing
    Set MySelectedItem = Nothing

End Sub

Eigentlich funktioniert der Code recht gut bei allen Arten von Anhängen. Das gilt für echte angehängte Dateien, als auch für im Mailbody integrierte Bilder(dateien).

Jetzt bin ich über eine E-Mail gestolpert, bei der der Code ein Problem hat:

Diese E-Mail hat drei integrierte Bilder, aber der Code erfasst nur das erste. Die anderen überspringt er. Er läuft ohne Ausnahme durch.