Automatischer Anhang download und Umbenennung nach Betreff Zeile

Hallo,

ich bekomme jeden Tag Auftragsbestätigungen aus SAP per Mail, natürlich nicht auftragsbezogen, sondern mit einer Systemnummerierung.

Ich benötige ein Makro, welches den Anhang einer E-Mail aus einem definierten Outlook Ordner in einen bestimmten Windows-Ordner herunterlädt und nach dem Betreff der E-Mail benennt.
Sagen wir der Outlook Ordner heisst Asena und der ordner auf dem Desktop Asena test.
Kann mir hierbei jemand helfen? Ich konnte folgende Vorlage hier im Forum finden:

Dim strNewFolder As String
Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
Dim oAttachment As Attachment
Dim ts() as String

strNewFolder = "W:\VBA_TEST\"
On Error GoTo check_error
MkDir strNewFolder
Back1:
Set objPosteingang =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each Item In objPosteingang.Items
If Item.Class = olMail Then
Set objNewMail = Item
With objNewMail

If .UnRead = True Then

intanlagen = .Attachments.Count

'Hier die Betreffzeile der Mail lesen und dann nach Factura trennen
ts=split(objnewmail.subject ,"Factura")
'dann sollte in ts(1) die Rechnungsnummer mit einem Leerzeichen stehen

Debug.Print objNewMail & ": "; intanlagen If intanlagen > 0 Then For i = 1 To intanlagen Set oAttachment = .Attachments.Item(i) oAttachment.SaveAsFile strNewFolder & "\" & trim(ts(1)) & ".pdf"

Next i
End If
End If
End With
End If
Next Item

check_error:
Debug.Print Err.Number; Err.Description
If Err.Number = 75 Then ' Fehler beim Zugriff auf Pfad -- ignorieren wir mal Err.Clear

GoTo Back1:
Else
'Err.Raise Err.Number, Err.Description

End If
Err.Clear
Resume Next

End Sub

Vielen Dank im vorraus.
Gruß
Michael