Hallo,

den Code hab ich online gefunden, aber ich hab den Link nicht mehr. Hier ist der Code, den ich aktuell verwende:

Sub email_Anhang_Sperr1_speichern()

'Author: Friedrich Hofmann
'Erstelldatum: 16.11.2015

'Zweck: Mehrere email-Anhänge (Infos zu den Sperrflächen) sollen aus Outlook heraus gespeichert und
'im Anschluss bearbeitet werden.

'--------------------------------------------------------------------------
'ACHTUNG: Das Funktionieren dieses Codes setzt voraus, dass im VB-Editor
'im Menü "Tools->References" die "MS Outlook nn Objektbibliothek" referenziert
'wird (einfach die Checkbox anhaken)
'---------------------------------------------------------------------------

  Dim objOL As Object, objFolder As Object 'Es werden mehrere Objektinstanzen erzeugt
  '("late binding", die Objektinstanzen sind noch unspezifiziert)
  
  'Das Workbook ist ohnehin schon offen.
  'Wir müssen nur das richtige Sheet auswählen.
  Sheets("Doku").Select
  Range("A100").Select 'Wir müssen einen Bereich auswählen, wo sicherlich nichts mehr steht.
  ActiveCell.FormulaR1C1 = "Titel"
  ActiveCell.Offset(1, 0).Select
  ActiveCell.FormulaR1C1 = "64_Sperr1_Parts - xls_daily_mail (QS)"
  '64_Sperr1_Parts - xls_daily_mail (QS)
  emailtitle = ActiveCell


  'MsgBox emailtitle
  
  On Error GoTo ErrExit 'Hier werden Fehler durch eine eigene Prozedur abgefangen.
  
  With Application 'Das Makro läuft in Excel.
    .ScreenUpdating = False 'Indem der Bildschirm nicht andauernd aktualisiert wird, geht es schneller
    .EnableEvents = False
    lngCalc = .Calculation 'Hier wird eigtl nichts eingestellt, es wird nur eine Variable befüllt
    .Calculation = xlCalculationManual 'Da das Makro in Excel läuft, wird einfach auf manuelle Neuberechnung umgestellt.
    .DisplayAlerts = False
  End With
  
  'In diesen Pfad soll der Anhang gespeichert werden
  '----------------------------------------------------------------------------------
  'ACHTUNG: Diese Variable wird in der Prozedur für Sperr2 noch einmal definiert, sie muss aber
  'genau dieselbe sein. Wenn sich was ändert, muss man also darauf aufpassen!
  '----------------------------------------------------------------------------------
  v_path1 = "S:\Quality\27_Temp\Crystal_Sperr_1_2_Reports"
  v_path1 = IIf(Right(v_path1, 1) = "\", v_path1, v_path1 & "\")
  
  Set objOL = CreateObject("Outlook.Application")
' Die Konstante olFolderInbox entspr. wohl der Nr. 6
  Set objFolder = objOL.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)


  lngCount = objFolder.Items.Count 'Das ist die Anzahl von emails im Posteingang
  
'  MsgBox lngCount
  
 lngRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row 'Hier wird einfach die erste freie Zelle in Spalte A gesucht
  

  For lngCur = 1 To lngCount 'Alle emails im Posteingang werden durchlaufen
    Application.StatusBar = "Lese Posteingang " & _
      Format(lngCur / lngCount, "0%") 'In der Statuszeile wird einiges angezeigt
    With objFolder.Items(lngCur) 'Durch diese WITH-Schleife kann die Nennung des Objekts
    'bei den nächsten Befehlen entfallen
    'In dem Postfach liegen mglw ziemlich viele Alt-emails rum, wir wollen nur die eine, die mit dem
    'bekannten Betreff am aktuellen Tag gekommen ist.
    If Format(.ReceivedTime, "DD.MM.YYYY") = Format(Date, "DD.MM.YYYY") Then
      If .Subject = emailtitle Then
        lngRow = lngRow + 8
        Cells(lngRow + 1, 1).Value = .Subject
        Cells(lngRow + 2, 1).Value = .ReceivedTime
        Cells(lngRow + 3, 1).Value = .SenderName
        Cells(lngRow + 4, 1).Value = .SenderEmailAddress
        Cells(lngRow + 5, 1).Value = .Body
        Cells(lngRow + 6, 1).Value = .Attachments.Count
         If .Attachments.Count > 0 Then
          For lngIndex = 1 To .Attachments.Count
            Debug.Print strPath & .Attachments.Item(lngIndex).Filename 'Ausgabe im Direktfenster! (Strg+G)
            .Attachments.Item(lngIndex).SaveAsFile v_path1 & .Attachments.Item(lngIndex).Filename
          Next
        End If
        .UnRead = False 'als gelesen markieren
       End If
      End If
    End With
    Cells(lngRow + 2, 1).Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "= DATE(YEAR(RC[-1]),MONTH(RC[-1]),DAY(RC[-1]))"
    Cells(lngRow, 1).Select 'Jetzt müssen wir nur schnell wieder zurückspringen, damit da nichts schiefgehen kann.
  Next
  
  [A2].Select
  ActiveWorkbook.Saved = True
  
ErrExit:
  
  With Err
    If .Number <> 0 Then
      MsgBox "Fehler in Prozedur:" & vbTab & "'OutlookPosteingang'" & vbLf & String(60, "_") & _
        vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
        "Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
        .Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
        "VBA - Fehler in Modul - Modul1"
      .Clear
    End If
  End With
  
  On Error GoTo 0
  
  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = lngCalc
    .DisplayAlerts = True
    .StatusBar = False
  End With
  
  Set objFolder = Nothing
  Set objOL = Nothing

End sub

Wie man sehen kann, verwendet dieser Code die Konstante olFolderInbox - die Inhalte der gesuchten email (anhand der Betreffzeile identifiziert) werden in die aktive Excel-Datei geschrieben, die Anhänge runtergeladen und in der Folge weiterverarbeitet.

Gruß,

Officer_Bierschnitt