Sub
TerminErstellen()
Dim
OL
As
Outlook.Application, Appoint
As
Outlook.AppointmentItem, ES
As
Worksheet, WB
As
Workbook, TP
As
Worksheet, Tag
As
Worksheet
Dim
intRow
As
Integer
Dim
Startzeit
As
Date
Dim
VarDat
As
Variant
Dim
Teilnehmer
As
Variant
Set
WB = ThisWorkbook
Set
TP = WB.Sheets(
"Terminplanung"
)
Set
Tag = WB.Sheets(
"Tage"
)
VarDat = Tabelle2.Range(
"f1:t1"
,
"F2:v2"
)
Teilnehmer = VarDat(1, 1) +
";"
+ VarDat(1, 2) +
";"
+ VarDat(1, 3) +
";"
+ VarDat(1, 4) +
";"
+ VarDat(1, 5) +
";"
+ VarDat(1, 6) +
";"
+ VarDat(1, 7) +
";"
+ VarDat(1, 8) +
";"
+ VarDat(1, 9) +
";"
+ VarDat(1, 10) +
";"
+ VarDat(1, 11)
Anfang = TP.Cells(4, 2).Value
Ende = TP.Cells(4, 3).Value
For
intRow = Anfang
To
Ende
Set
OL =
New
Outlook.Application
Recipient = TP.Cells(3, 2).Value
DayMeeting = TP.Cells(9, 2).Value
StartTime = Tag.Cells(intRow, 4).Value
Start = Tag.Cells(intRow, 1).Value
Startzeit = Tag.Cells(intRow, 2).Value
EndTime = Tag.Cells(intRow, 5).Value
Location = TP.Cells(2, 2).Value
Subject = TP.Cells(3, 2).Value &
" am "
& Start
Greeting = TP.Cells(7, 2).Value
BodyA = TP.Cells(9, 2).Value & Chr(13) & Chr(13) &
"Am: "
& Start &
" um "
& Startzeit &
" Uhr "
& Chr(13) &
"Im: "
& TP.Cells(2, 2).Value &
" "
BodyB = TP.Cells(11, 2).Value
BodyC = TP.Cells(13, 2).Value
FinishA = TP.Cells(17, 2).Value & Chr(13) &
" "
FinishB = TP.Cells(18, 2).Value
Set
Appoint = OL.CreateItem(olAppointmentItem)
With
Appoint
.MeetingStatus = olMeeting
.RequiredAttendees = Teilnehmer
.Subject = Subject
.Start = StartTime
.
End
= EndTime
.Location = Location
.AllDayEvent =
False
.Body = Greeting & Chr(10) & Chr(10) & BodyA & Chr(10) & Chr(10) & BodyB & Chr(10) & Chr(10) & BodyC & Chr(10) & Chr(10) & FinishA & Chr(10) & FinishB
.Display
End
With
Set
OL =
Nothing
Next
intRow
End
Sub