Bestimmte Datei unter allen angehängten Dateien finden

Ich konnte inzwischen mein Problem – mit Hilfe von Tipps aus einem anderen Forum – lösen. Mein Code sieht nun so aus und funktioniert bei mir einwandfrei:

Sub Anhang_Speichern()
Dim OLApp As Outlook.Application
Dim OLNS As Outlook.Namespace
Dim OLOrdner As MAPIFolder
Dim Nachricht As Outlook.MailItem
Dim AnhName As String
Dim TempOrdner As String
Dim ZielRepo As String
Dim Quartal As String
Dim KDNR As String

Set OLApp = Outlook.Application
Set OLNS = OLApp.GetNamespace(\“MAPI\“)
Set OLOrdner = OLNS.PickFolder

TempOrdner = \“C:\\Testordner1\\\“
ZielRepo = \“C:\\Testordner2\\\“

On Error Resume Next

For Each Nachricht In OLOrdner.Items

If Nachricht.UnRead = True Then
Anzahl = Nachricht.Attachments.Count
If Anzahl > 0 Then
For i = 1 To Anzahl
AnhName = Nachricht.Attachments.item(i).Filename
If InStr(AnhName, \“Repo\“) > 0 Then
Nachricht.Attachments.item(i).SaveAsFile TempOrdner & AnhName

Workbooks.Open TempOrdner & AnhName
BCNR = Sheets(\“Lieferschein\“).Range(\“C15\“)
Quartal = Sheets(\“Lieferschein\“).Range(\“H11\“)
ActiveWorkbook.SaveAs ZielRepo & KDNR & \“-\“ & \“Repo_\“ & Quartal & \“.xlsx\“
ActiveWorkbook.Close False
Kill TempOrdner & AnhName
End If
Next i

End If
End If

Set Nachricht = Outlook.ActiveInspector.CurrentItem
Nachricht.Subject = KDNR & \“-\“ & Nachricht.Subject
Nachricht.UnRead = False
Nachricht.Save
Set OLOrdnerQuartal = OLNS.PickFolder
Nachricht.Move (OLOrdnerQuartal)

Next Nachricht

MsgBox \“ Alle Mails wurden bearbeitet!\“

End Sub

Vielleicht hilft der Code ja sonst noch jemandem weiter 😉
Gruss coko