Bestimmte Datei unter allen angehängten Dateien finden

Hallo Experten!

Ich bekomme im Outlook Mails von Kunden mit immer den gleichen Anhängen. Nun muss ich jeweils einen bestimmten Anhang abspeichern und zwar eine Excel-Datei, die immer gleich heisst. Damit ich sie unterscheiden kann, muss ich ihr die Kundennummer voranstellen, die ich in der Datei auf der Tabelle \”Lieferschein\” finde. Mit nachfolgendem Makro suche ich in den Anhängen nach der Datei \”Repo\”, öffne sie und speichere sie unter dem neuen Namen ab.

Soweit funktioniert der Code. Nur wenn die gesuchte Datei nicht dem ersten Anhang entspricht, wird die Datei nicht abgespeichert. Kann mir jemand helfen, wie ich den Code anpassen muss, damit die Datei unter allen Anhängen gefunden wird?

Ausserdem hänge ich am Ende des neuen Dateinamens noch das entsprechende Quartal an, welches ich ebenfalls auf dem Lieferschein finde (Zelle H11). Dort ist das Quartal im Format \”30.06.2011\” gespeichert. Ich möchte im Dateinamen aber das Format \”201106\” verwenden: wie kann ich das erreichen?

Bin für jede Hilfe dankbar!

Gruss coko

PS: Ich muss Outlook aus Excel heraus steuern, weil bei uns in der Firma aus Sicherheitsgründen Makros in Outlook deaktiviert sind.

Hier mein Code:

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
If Nachricht.Attachments.Count > 0 Then
AnhName = Nachricht.Attachments.item(1).DisplayName
If InStr(AnhName, \”Repo\”) > 0 Then
Nachricht.Attachments.item(1).SaveAsFile TempOrdner & AnhName

Workbooks.Open TempOrdner & AnhName
KDNR = Sheets(\”Lieferschein\”).Range(\”C15\”)
Quartal = Sheets(\”Lieferschein\”).Range(\”H11\”)
ActiveWorkbook.SaveAs ZielRepo & KDNR & \”-\” & \”Repo_\” & Quartal & \”.xlsx\”
ActiveWorkbook.Close False
Kill TempOrdner & AnhName

End If
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