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