Liebe Excelfreunde,
leider komme ich mit meinem Projekt nicht weiter, bzw. weiss ich nicht wie ich es realisieren kann.
Folgende Herausforderung:
Ich habe 2 Excelsheets:
1)Terminplanung: Hier habe ich den Terminbetreff, den Ort und mehrere Textreihen, die in den Termintext eingefügt werden sollen. "Termine:" gibt an, wieviel Termine erstellt werden sollen (Reihe von/bis aus dem Sheet Termine).
Outlook-Termine erstellen |
|
|
Ort |
Raum 12 |
|
(Ort angeben.) |
Betreff: |
Treffen |
|
(Bitte angeben.) |
Termine: |
2 |
6 |
|
|
|
|
|
|
|
|
|
Email Teil A: |
Hallo, |
|
|
|
|
|
|
Email Teil B: |
1. Textreihe |
|
|
|
|
|
|
Email Teil C: |
2. Textreihe |
|
|
|
|
|
|
Email Teil D: |
3. Textreihe |
|
|
|
|
|
|
Email Teil E: |
4.Textreihe |
|
|
|
|
|
|
Gruss: |
Viele Grüße |
|
|
Name: |
Max Muster |
|
|
2) Termine: Hier werden alle Termine eingetragen und die E-Mail Adressen der Terminempfänger
3) Zielsetzung
Es sollen insgesamt immer 11 Personen zu den Terminen eingeladen werden (Oben im Beispiel sind nicht alle aufgeführt). Die Herausforderung ist nun, dass wenn bei einem Termin und Person ein "x" eingetragen ist, soll diese Person nicht eingeladen werden, dafür dann aber die 12.te Person.
In dem Beispiel oben bei 2) soll also email1@muster.de und email2@Muster.de nicht eingeladen werden dafür aber die 12.te und 13.te Person
4) Quellcode:
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)
'Schleife (Anzahl der Termine die erstellt werden sollen)
Anfang = TP.Cells(4, 2).Value
Ende = TP.Cells(4, 3).Value
For intRow = Anfang To Ende
Set OL = New Outlook.Application
'Variablen festlegen
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
'Eintragen der Variablen in die Outlooktermin(e)
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
'.OptionalAttendees = "E-Mail2"
.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
'.Save (direkt versenden)
End With
Set OL = Nothing
Next intRow
End Sub
Problem:
Ich habe kein Plan wie ich die Zielsetzung realisieren kann. Im Quellcode habe ich versucht, die Email-Adressen und die 2.te Reihe (mit den "x" erst einmal in ein Array einzulesen um zu Probieren ob ich es hinbekomme. Leider bin ich mit meinem Latain am Ende.
Es wäre echt mega, wenn mir hierbei jemand von euch helfen würde.
Ich bedanke mich schon mal herzlich für jede Hilfe!
LG
Thomas
|