Option
Explicit
Sub
OL_Termin_Einstellen()
Dim
oOLApp
As
Object
, oTermin
As
Object
Dim
i
As
Integer
, j
As
Integer
, sArr()
As
String
Dim
sBetreff
As
String
, sAbsender
As
String
, sMailtext
As
String
Const
olFolderInbox = 6
Set
oOLApp = CreateObject(
"Outlook.Application"
)
With
oOLApp.GetNamespace(
"MAPI"
).Folders(
"Ich@t-online.de"
).Folders(
"Posteingang"
)
For
i = 1
To
.Items.Count
With
.Items(i)
sAbsender = .SenderName
sBetreff = .Subject
sMailtext = .body
If
sAbsender
Like
"Max.Mustermann@web.de"
Then
sArr = Split(sMailtext,
","
)
For
j = 0
To
UBound(sArr)
Next
j
Set
oTermin = oOLApp.CreateItem(1)
With
oTermin
.Start = Format((
Date
+ 1),
"dd.mm.yyyy"
) &
" 09:00"
.
End
= Format((
Date
+ 2),
"dd.mm.yyyy"
) &
" 09:00"
.Subject = sBetreff
.body = sMailtext
.Location =
"Ort"
.Save
.Display
End
With
Set
oTermin =
Nothing
End
If
End
With
Next
i
End
With
Set
oOLApp =
Nothing
End
Sub