Office: iCal Terminliste importieren/ erstellen

Hallo zusammen!

Ich frag einfach mal drauf los, vielleicht hat ja einer von euch nen Klugen rat. ;)

Ausgangslage ist, dass ich sich unzyklische Terminpläne als PDF angeliefert bekomme, welche in iCal (heute Kalender genannt) importiert werden sollen.
Die Terminpläne werden als PDF erzeugt, dass lässt sich nicht ändern, da die EDV-Anwendung zur Erstellung nur diese Möglichkeit bietet. Soweit ist das auch noch kein Problem. PDF-Inhalte in andere Programme, vor allem MS-Excel, zu übernehmen ist ja überhaupt kein Problem. Doch wie bekomme ich das in eine iCal-fähige *.ICS oder *.ICBU Datei gebaut?

ICS Datein sind vom Aufbau zwar menschlich lesbar aber eine Liste mit händisch geänderten Daten zu erstellen... Das dauert ja noch länger als die Termine von Hand in iCal zu tackern.... :p


Das einzige deutsche was ich bisher fand ist Unten nochmal ausgeführt.

Wenn ich das Makro laufen lasse, dann erzeugt es genau einen Eintrag. :-(
Was aber gemacht werden soll ist auslesen z.B. A2:A13 und dann Zeile für Zeile einen Gesamtereignis erstellen, so dass am Ende z.B. 01.05. - 12.05. umfasst sind.

Jemand ne Idee?

VG,
Jojo

http://www.herber.de/forum/archiv/12...ender_ics.html

Sub ICS_Erstellen()

Range("A2").Select

'Erstellt den Zeitstempel
'wird benötigt für die UID des Kalendereintrages und für die Felder
'"erstellt am" --> "DTSTAMP" und "zuletzt geändert am" --> "LAST-MODIFIED"
Dim jahr_jetzt As String
jahr_jetzt = Year(Now)
Dim monat_jetzt As String * 2
monat_jetzt = Month(Now)
If monat_jetzt < 10 Then monat_jetzt = "0" + monat_jetzt
Dim tag_jetzt As String * 2
tag_jetzt = Day(Now)
If tag_jetzt < 10 Then tag_jetzt = "0" + tag_jetzt
Dim stunde_jetzt As String * 2
stunde_jetzt = Hour(Now) - 1
If stunde_jetzt < 10 Then stunde_jetzt = "0" + stunde_jetzt
Dim minute_jetzt As String * 2
minute_jetzt = Minute(Now)
If minute_jetzt < 10 Then minute_jetzt = "0" + minute_jetzt
Dim sekunde_jetzt As String * 2
sekunde_jetzt = Second(Now)
If sekunde_jetzt < 10 Then sekunde_jetzt = "0" + sekunde_jetzt
zeitstempel = jahr_jetzt + monat_jetzt + tag_jetzt + "T" + stunde_jetzt + minute_jetzt + _
sekunde_jetzt + "Z"

'Erstellt die Kalenderdatei (hier: Dpl.ics)
'Dateiname kann frei gewählt werden
'Der entsprechende Ordner MUSS vorhanden sein, da sonst ein Fehler auftritt
Set fs = CreateObject("scripting.filesystemobject")
Set a = fs.createtextfile("C:\Dokumente und Einstellungen\p.ohlendorf\Desktop\DMS\Dpl.ics", _
True)

'Schreibt den allgemeinen Teils der Kalenderdatei
a.writeline ("BEGIN:VCALENDAR")
a.writeline ("VERSION:2.0")
a.writeline ("PRODID:-//Mozilla.org/NONSGML Mozilla Calendar V1.1//EN")
a.writeline ("METHOD:PUBLISH")
a.writeline ("BEGIN:VTIMEZONE")
a.writeline ("TZID:Europe/Berlin")
a.writeline ("X-LIC-LOCATION:Europe/Berlin")
a.writeline ("BEGIN:DAYLIGHT")
a.writeline ("TZOFFSETFROM:+0100")
a.writeline ("TZOFFSETTO:+0200")
a.writeline ("TZNAME:CEST")
a.writeline ("DTSTART:19700329T020000")
a.writeline ("RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=3")
a.writeline ("END:DAYLIGHT")
a.writeline ("BEGIN:STANDARD")
a.writeline ("TZOFFSETFROM:+0200")
a.writeline ("TZOFFSETTO:+0100")
a.writeline ("TZNAME:CET")
a.writeline ("DTSTART:19701025T030000")
a.writeline ("RRULE:FREQ=YEARLY;BYDAY=-1SU;BYMONTH=10")
a.writeline ("END:STANDARD")
a.writeline ("END:VTIMEZONE")

'Schleife zur Ermittlung aller Einträge
'Benutzt alle Datensätze, die ein Datum enthalten
i = 1
While ActiveCell.Offset(i, 0) ""

Dim datstart As Date
datstart = ActiveCell.Offset(i, 0)
Dim timestart As Date
timestart = ActiveCell.Offset(i, 1)
Dim datend As Date
datend = ActiveCell.Offset(i, 2)
Dim timeend As Date
timeend = ActiveCell.Offset(i, 3)
Dim thema As String
thema = ActiveCell.Offset(i, 4)
Dim ort As String
ort = ActiveCell.Offset(i, 5)
Dim diensthabender As String
diensthabender = ActiveCell.Offset(i, 6)

'Aufbereitung Datum und Zeit für Beginn
Dim jdatstart As String
jdatstart = Year(datstart)
Dim mdatstart As String
mdatstart = Month(datstart)
If mdatstart < 10 Then mdatstart = "0" + mdatstart
Dim tdatstart As String
tdatstart = Day(datstart)
If tdatstart < 10 Then tdatstart = "0" + tdatstart
Dim hhtimestart As String
hhtimestart = Hour(timestart)
If hhtimestart < 10 Then hhtimestart = "0" + hhtimestart
Dim mmtimestart As String
mmtimestart = Minute(timestart)
If mmtimestart < 10 Then mmtimestart = "0" + mmtimestart
Dim sstimestart As String
sstimestart = "00"

'Aufbereitung Datum und Zeit für Ende
Dim jdatend As String
jdatend = Year(datend)
Dim mdatend As String
mdatend = Month(datend)
If mdatend < 10 Then mdatend = "0" + mdatend
Dim tdatend As String
tdatend = Day(datend)
If tdatend < 10 Then tdatend = "0" + tdatend
Dim hhtimeend As String
hhtimeend = Hour(timeend)
If hhtimeend < 10 Then hhtimeend = "0" + hhtimeend
Dim mmtimeend As String
mmtimeend = Minute(timeend)
If mmtimeend < 10 Then mmtimeend = "0" + mmtimeend
Dim sstimeend As String
sstimeend = "00"



Dim k As String
k = i

'Schreibt den Kalendereintrag
'k ist ein durchlaufender Zähler
a.writeline ("BEGIN:VEVENT")
a.writeline ("UID:" + zeitstempel + "-@Verein-" + k)
a.writeline ("CLASS:PUBLIC")
a.writeline ("SUMMARY:" + thema)
a.writeline ("DESCRIPTION:" + "Diensthabender: " + diensthabender)
a.writeline ("LOCATION:" + ort)
a.writeline ("DTSTART;TZID=Europe/Berlin:" + jdatstart + mdatstart + tdatstart + "T" + _
hhtimestart + mmtimestart + sstimestart + "Z")
a.writeline ("DTEND;TZID=Europe/Berlin:" + jdatend + mdatend + tdatend + "T" + hhtimeend + _
mmtimeend + sstimeend + "Z")
a.writeline ("DTSTAMP:" + zeitstempel)
a.writeline ("LAST-MODIFIED:" + zeitstempel)
a.writeline ("BEGIN:VALARM")
a.writeline ("ACTION:DISPLAY")
a.writeline ("TRIGGER;VALUE=DURATION1D")
a.writeline ("DESCRIPTION:Mozilla Alarm: " + thema)
a.writeline ("END:VALARM")
a.writeline ("END:VEVENT")

i = i + 1
Wend
'Ende der Schleife

'Ende der Kalenderdatei
a.writeline ("END:VCALENDAR")

End Sub

:)