ICS Import zu Excel
Falls es jemanden interessiert.
Auf Grundlage einer gefundenen Anleitung habe ich mal ein Makro (VBA) für Excel angepasst, welches iCal-Dateien (ICS-Format) direkt in eine Excel-Tabelle einlesen kann.
Der Code könnte vielleicht noch etwas optimiert werden (wiederkehrende Befehlszeilen) aber es funktioniert erstmal.
Mit der SplitDate-Routine werden nur noch die DTSTART und DTEND Werte zum leichteren Editieren aufgeteilt.
Kann man manuell oder bei Bedarf auch automatisch ausführen.
Ein Export-Funktion hätte ich auch anzubieten, die müßte aber noch an diese Tabelle angepasst werden.
Viel Vergnügen damit
PS: Ist nur teilweise mein Knowhow, hoffe es erfüllt die Voraussetzung zum Veröffentlichen.
Auf Grundlage einer gefundenen Anleitung habe ich mal ein Makro (VBA) für Excel angepasst, welches iCal-Dateien (ICS-Format) direkt in eine Excel-Tabelle einlesen kann.
Der Code könnte vielleicht noch etwas optimiert werden (wiederkehrende Befehlszeilen) aber es funktioniert erstmal.
Sub ICS_Import()
' modifiziert nach: https://www.experts-exchange.com/questions/26193790/Importing-Calendar-files-into-Excel-ics-xls.html
' This version require a reference to a "Microsoft ActiveX Data Objects"
Dim filename As String
filename = Application.GetOpenFilename("Calendar Files (*.ics),*.ics")
If filename = "False" Then Exit Sub
Dim objStream, strData
Dim r As Long, c As Long, line As String, dtStr As String, aStr As String, mlValue As String, dtArr() As String
Dim colNames As Variant
colNames = Array("DTSTART", "DTEND", "DTSTAMP", "UID", "CREATED", "DESCRIPTION", "RRULE", "LAST-MODIFIED", "LOCATION", "SEQUENCE", "STATUS", "SUMMARY", "TRANSP")
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.Type = adTypeText
objStream.LoadFromFile (filename)
c = 0
For c = 0 To 12
Cells(1, c + 1).Value = colNames(c)
Next c
r = 2
line = objStream.ReadText(adReadLine)
Do Until objStream.EOS
If Left(line, 1) <> Chr(9) Then
aStr = Split(line, ":")(0)
End If
Select Case True
Case Left(line, 7) = "DTSTART"
dtStr = Replace(line, aStr & ":", "")
Cells(r, 1).NumberFormat = "yyyy-mm-dd hh:mm:ss"
Cells(r, 1) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
Case Left(line, 5) = "DTEND"
dtStr = Replace(line, aStr & ":", "")
Cells(r, 2).NumberFormat = "yyyy-mm-dd hh:mm:ss"
Cells(r, 2) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
Case Left(line, 7) = "DTSTAMP"
dtStr = Replace(line, aStr & ":", "")
Cells(r, 3).NumberFormat = "yyyy-mm-dd hh:mm:ss"
Cells(r, 3) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
Case Left(line, 3) = "UID"
Cells(r, 4) = Replace(line, aStr & ":", "")
Case Left(line, 7) = "CREATED"
dtStr = Replace(line, aStr & ":", "")
Cells(r, 5).NumberFormat = "yyyy-mm-dd hh:mm:ss"
Cells(r, 5) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
Case Left(line, 11) = "DESCRIPTION"
Cells(r, 6) = Replace(line, aStr & ":", "")
Case Left(line, 5) = "RRULE"
Cells(r, 7) = Replace(line, aStr & ":", "")
Case Left(line, 13) = "LAST-MODIFIED"
dtStr = Replace(line, aStr & ":", "")
Cells(r, 8).NumberFormat = "yyyy-mm-dd hh:mm:ss"
Cells(r, 8) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
Case Left(line, 8) = "LOCATION"
Cells(r, 9) = Replace(line, aStr & ":", "")
Case Left(line, 8) = "SEQUENCE"
Cells(r, 10) = Replace(line, aStr & ":", "")
Case Left(line, 6) = "STATUS"
Cells(r, 11) = Replace(line, aStr & ":", "")
Case Left(line, 7) = "SUMMARY"
Cells(r, 12) = Replace(line, aStr & ":", "")
Case Left(line, 6) = "TRANSP"
Cells(r, 13) = Replace(line, aStr & ":", "")
Case Left(line, 10) = "END:VEVENT"
r = r + 1
End Select
line = objStream.ReadText(adReadLine)
Loop
Dim Spalte As Range
For Each Spalte In ActiveSheet.UsedRange.Columns
Spalte.AutoFit
Next Spalte
End Sub
Function ParseDateZ(dtStr As String)
Dim dtArr() As String
Dim dt As Date
dtArr = Split(Replace(dtStr, "Z", ""), "T")
dt = DateSerial(Left(dtArr(0), 4), Mid(dtArr(0), 5, 2), Right(dtArr(0), 2))
If UBound(dtArr) > 1 Then
dt = dt + TimeSerial(Left(dtArr(1), 2), Mid(dtArr(1), 3, 2), Right(dtArr(1), 2))
End If
ParseDateZ = dt
End Function
Sub SplitDate()
Dim LastRow, i
LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Columns("B").Insert Shift:=xlToRight
Columns("D").Insert Shift:=xlToRight
Cells(1, 2).Value = "TIMESTART"
Cells(1, 4).Value = "TIMEEND"
For i = 2 To LastRow
Cells(i, 2) = Cells(i, 1)
Cells(i, 4) = Cells(i, 3)
Columns("A").NumberFormat = "dd.mm.yyyy"
Columns("B").NumberFormat = "hh:mm:ss"
Columns("C").NumberFormat = "dd.mm.yyyy"
Columns("D").NumberFormat = "hh:mm:ss"
Next
End Sub
Mit der SplitDate-Routine werden nur noch die DTSTART und DTEND Werte zum leichteren Editieren aufgeteilt.
Kann man manuell oder bei Bedarf auch automatisch ausführen.
Ein Export-Funktion hätte ich auch anzubieten, die müßte aber noch an diese Tabelle angepasst werden.
Viel Vergnügen damit
PS: Ist nur teilweise mein Knowhow, hoffe es erfüllt die Voraussetzung zum Veröffentlichen.
Please also mark the comments that contributed to the solution of the article
Content-ID: 379164
Url: https://administrator.de/contentid/379164
Printed on: December 14, 2024 at 15:12 o'clock
18 Comments
Latest comment
Ich habe von Schulferien org. eine ics für Ferientermine runtergeladen und wollte die mit Deinem Makro in Excel importieren…
Der erste Stopp kam bei : objStream.Type = adTypeText
Als ich den gelöscht habe blieb ich stecken bei: aStr = Split(line, ":")(0)
Kannst Du Dein Makro bitte noch verbessern? So funktioniert es leider nicht.
Sorry ich schrieb gerad unter dem falschen Makro
Der erste Stopp kam bei : objStream.Type = adTypeText
Als ich den gelöscht habe blieb ich stecken bei: aStr = Split(line, ":")(0)
Kannst Du Dein Makro bitte noch verbessern? So funktioniert es leider nicht.
Sorry ich schrieb gerad unter dem falschen Makro
Ich habe von Schulferien org. eine ics für Ferientermine runtergeladen und wollte die mit Deinem Makro in Excel importieren…
Der erste Stopp kam bei : objStream.Type = adTypeText
Als ich den gelöscht habe blieb ich stecken bei: aStr = Split(line, ":")(0)
Kannst Du Dein Makro bitte noch verbessern? So funktioniert es leider nicht.
Der erste Stopp kam bei : objStream.Type = adTypeText
Als ich den gelöscht habe blieb ich stecken bei: aStr = Split(line, ":")(0)
Kannst Du Dein Makro bitte noch verbessern? So funktioniert es leider nicht.
Hey, klasse! So ein Makro suche ich schon ewig. Leider bekomme ich es nicht richtig zum Laufen.
Es geht in die "Do Until objStream.EOS"-Schleife nicht rein.
Das Ergebnis sieht dann so aus:
Dabei spielt es auch keine Rolle, ob ich das Makro in ein Tabellenblatt, in die Arbeitsmappe oder in ein Modul packe.
Die genannten Bibliotheken sind eingebunden, sonst käme ich ja gar nicht so weit ;)
Was mache ich denn falsch?
Viele Grüße
Es geht in die "Do Until objStream.EOS"-Schleife nicht rein.
Das Ergebnis sieht dann so aus:
Dabei spielt es auch keine Rolle, ob ich das Makro in ein Tabellenblatt, in die Arbeitsmappe oder in ein Modul packe.
Die genannten Bibliotheken sind eingebunden, sonst käme ich ja gar nicht so weit ;)
Was mache ich denn falsch?
Viele Grüße
Vielen Dank!
Der entscheidende Hinweis war, die .ical Datei nicht von schulferien.org, sondern von ferienwiki.de zu verwenden. Damit läuft es.
Ich kann zwar, wenn ich die Dateien mit WordPad öffne nur marginale Unterschiede feststellen, aber die von schulferien.org mag das Makro nicht.
Nochmals vielen Dank!
Der entscheidende Hinweis war, die .ical Datei nicht von schulferien.org, sondern von ferienwiki.de zu verwenden. Damit läuft es.
Ich kann zwar, wenn ich die Dateien mit WordPad öffne nur marginale Unterschiede feststellen, aber die von schulferien.org mag das Makro nicht.
Nochmals vielen Dank!
So, noch eine interessante Erkenntnis.
Ich lade von ferien.org eine beliebige .ics Datei herunter → Makro funktioniert nicht
Ich öffne diese .ics-Datei mit WordPad und speichere sie, ohne etwas zu verändern → Makro funktioniert
Das einzige, was vielleicht etwas damit zu tun haben könnte ist, dass dann diese Sicherheitseinstellung nicht mehr da ist:
Zwei Dinge sprechen allerdings gegen diese Theorie:
1. Die Datei von ferienwiki.de hat den selben Eintrag in den Eigenschaften und funktioniert trotzdem.
2. Wenn ich die Datei von schulferien.org nicht öffne und speichere, sondern nur in den Eigenschaften diesen Haken setze, funktioniert es trotzdem nicht.
Ich gebe es jetzt auf und nehme einfach die funktionierende Datei. Wollte es nur der Vollständigkeit halber posten, falls andere noch über diesen Beitrag stolpern.
Grüße vom Hessenheizer
Ich lade von ferien.org eine beliebige .ics Datei herunter → Makro funktioniert nicht
Ich öffne diese .ics-Datei mit WordPad und speichere sie, ohne etwas zu verändern → Makro funktioniert
Das einzige, was vielleicht etwas damit zu tun haben könnte ist, dass dann diese Sicherheitseinstellung nicht mehr da ist:
Zwei Dinge sprechen allerdings gegen diese Theorie:
1. Die Datei von ferienwiki.de hat den selben Eintrag in den Eigenschaften und funktioniert trotzdem.
2. Wenn ich die Datei von schulferien.org nicht öffne und speichere, sondern nur in den Eigenschaften diesen Haken setze, funktioniert es trotzdem nicht.
Ich gebe es jetzt auf und nehme einfach die funktionierende Datei. Wollte es nur der Vollständigkeit halber posten, falls andere noch über diesen Beitrag stolpern.
Grüße vom Hessenheizer