Sub SpeichereBestellungen()
Dim olApp As Object
Dim olNamespace As Object
Dim olInbox As Object
Dim olMail As Object
Dim olAttachment As Object
Dim fs As Object
Dim folderPath As String
Dim subject As String
Dim attachmentName As String
Dim orderNumber As String
Dim orderDescription As String
Dim savePath As String
Set olApp = CreateObject("Outlook.Application")
Set olNamespace = olApp.GetNamespace("MAPI")
Set olInbox = olNamespace.GetDefaultFolder(6)
Set fs = CreateObject("Scripting.FileSystemObject")
For Each olMail In olInbox.Items
If olMail.Subject = "Bestellung" And olMail.SenderEmailAddress = "X@example.com" Then
subject = olMail.Subject
orderNumber = GetOrderNumber(subject)
orderDescription = GetOrderDescription(subject)
folderPath = "C:\Aufträge\" & orderNumber & " - " & orderDescription
If Not fs.FolderExists(folderPath) Then
fs.CreateFolder folderPath
End If
For Each olAttachment In olMail.Attachments
attachmentName = olAttachment.FileName
savePath = folderPath & "\" & attachmentName
olAttachment.SaveAsFile savePath
Next olAttachment
End If
Next olMail
End Sub
Function GetOrderNumber(subject As String) As String
Dim parts() As String
parts = Split(subject, " ")
GetOrderNumber = parts(0)
End Function
Function GetOrderDescription(subject As String) As String
Dim parts() As String
parts = Split(subject, " ")
GetOrderDescription = Join(Application.Index(parts, 0, 2), " ")
End Function