Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

ICS Import zu Excel

Mitglied: PeterleB

PeterleB (Level 1) - Jetzt verbinden

04.07.2018 um 14:57 Uhr, 1643 Aufrufe, 3 Kommentare, 4 Danke

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.

01.
Sub ICS_Import()
02.
    ' modifiziert nach: https://www.experts-exchange.com/questions/26193790/Importing-Calendar-files-into-Excel-ics-xls.html
03.
    ' This version require a reference to a "Microsoft ActiveX Data Objects"
04.
    
05.
    Dim filename As String
06.
    filename = Application.GetOpenFilename("Calendar Files (*.ics),*.ics")
07.
    If filename = "False" Then Exit Sub
08.
    
09.
    Dim objStream, strData
10.
    Dim r As Long, c As Long, line As String, dtStr As String, aStr As String, mlValue As String, dtArr() As String
11.
    Dim colNames As Variant
12.
    colNames = Array("DTSTART", "DTEND", "DTSTAMP", "UID", "CREATED", "DESCRIPTION", "RRULE", "LAST-MODIFIED", "LOCATION", "SEQUENCE", "STATUS", "SUMMARY", "TRANSP")
13.
    
14.
    Set objStream = CreateObject("ADODB.Stream")
15.
    
16.
    objStream.Charset = "utf-8"
17.
    objStream.Open
18.
    objStream.Type = adTypeText
19.
    objStream.LoadFromFile (filename)
20.
    c = 0
21.
    For c = 0 To 12
22.
        Cells(1, c + 1).Value = colNames(c)
23.
        Next c
24.
    r = 2
25.
    line = objStream.ReadText(adReadLine)
26.
    Do Until objStream.EOS
27.
        If Left(line, 1) <> Chr(9) Then
28.
        aStr = Split(line, ":")(0)
29.
        End If
30.
        Select Case True
31.
            Case Left(line, 7) = "DTSTART"
32.
                dtStr = Replace(line, aStr & ":", "")
33.
                Cells(r, 1).NumberFormat = "yyyy-mm-dd hh:mm:ss"
34.
                Cells(r, 1) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
35.
            Case Left(line, 5) = "DTEND"
36.
                dtStr = Replace(line, aStr & ":", "")
37.
                Cells(r, 2).NumberFormat = "yyyy-mm-dd hh:mm:ss"
38.
                Cells(r, 2) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
39.
            Case Left(line, 7) = "DTSTAMP"
40.
                dtStr = Replace(line, aStr & ":", "")
41.
                Cells(r, 3).NumberFormat = "yyyy-mm-dd hh:mm:ss"
42.
                Cells(r, 3) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
43.
            Case Left(line, 3) = "UID"
44.
                Cells(r, 4) = Replace(line, aStr & ":", "")
45.
            Case Left(line, 7) = "CREATED"
46.
                dtStr = Replace(line, aStr & ":", "")
47.
                Cells(r, 5).NumberFormat = "yyyy-mm-dd hh:mm:ss"
48.
                Cells(r, 5) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
49.
            Case Left(line, 11) = "DESCRIPTION"
50.
                Cells(r, 6) = Replace(line, aStr & ":", "")
51.
            Case Left(line, 5) = "RRULE"
52.
                Cells(r, 7) = Replace(line, aStr & ":", "")
53.
            Case Left(line, 13) = "LAST-MODIFIED"
54.
                dtStr = Replace(line, aStr & ":", "")
55.
                Cells(r, 8).NumberFormat = "yyyy-mm-dd hh:mm:ss"
56.
                Cells(r, 8) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
57.
            Case Left(line, 8) = "LOCATION"
58.
                Cells(r, 9) = Replace(line, aStr & ":", "")
59.
            Case Left(line, 8) = "SEQUENCE"
60.
                Cells(r, 10) = Replace(line, aStr & ":", "")
61.
            Case Left(line, 6) = "STATUS"
62.
                Cells(r, 11) = Replace(line, aStr & ":", "")
63.
            Case Left(line, 7) = "SUMMARY"
64.
                Cells(r, 12) = Replace(line, aStr & ":", "")
65.
            Case Left(line, 6) = "TRANSP"
66.
                Cells(r, 13) = Replace(line, aStr & ":", "")
67.
            Case Left(line, 10) = "END:VEVENT"
68.
                r = r + 1
69.
        End Select
70.
        line = objStream.ReadText(adReadLine)
71.
    Loop
72.
    Dim Spalte As Range
73.
    For Each Spalte In ActiveSheet.UsedRange.Columns
74.
        Spalte.AutoFit
75.
        Next Spalte
76.
End Sub
77.
 
78.
Function ParseDateZ(dtStr As String)
79.
    Dim dtArr() As String
80.
    Dim dt As Date
81.
    dtArr = Split(Replace(dtStr, "Z", ""), "T")
82.
    dt = DateSerial(Left(dtArr(0), 4), Mid(dtArr(0), 5, 2), Right(dtArr(0), 2))
83.
    If UBound(dtArr) > 1 Then
84.
        dt = dt + TimeSerial(Left(dtArr(1), 2), Mid(dtArr(1), 3, 2), Right(dtArr(1), 2))
85.
    End If
86.
    ParseDateZ = dt
87.
End Function
88.
 
89.
Sub SplitDate()
90.
    Dim LastRow, i
91.
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
92.
    
93.
    Columns("B").Insert Shift:=xlToRight
94.
    Columns("D").Insert Shift:=xlToRight
95.
    Cells(1, 2).Value = "TIMESTART"
96.
    Cells(1, 4).Value = "TIMEEND"
97.
    
98.
    For i = 2 To LastRow
99.
        Cells(i, 2) = Cells(i, 1)
100.
        Cells(i, 4) = Cells(i, 3)
101.
        
102.
    Columns("A").NumberFormat = "dd.mm.yyyy"
103.
    Columns("B").NumberFormat = "hh:mm:ss"
104.
    Columns("C").NumberFormat = "dd.mm.yyyy"
105.
    Columns("D").NumberFormat = "hh:mm:ss"
106.
    Next
107.
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.
Mitglied: beidermachtvongreyscull
06.07.2018 um 10:06 Uhr
Ich sag Dir mal herzlichen Dank dafür.
Es ist schön, wenn Kollegen ihr Wissen teilen.
Bitte warten ..
Mitglied: PeterleB
06.07.2018 um 10:40 Uhr
Das freut mich.

Gruß Peter
Bitte warten ..
Mitglied: PeterleB
09.07.2018 um 07:26 Uhr
Hab' mal am Code noch ein bisschen herumgeschraubt. TIMESTART und TIMEEND werden gleich mit angelegt und mit charset = "_autodetect_all" werden hoffentlich alle Char-Codes erkannt.

01.
Sub ICS_Import()
02.
    ' modifiziert nach: https://www.experts-exchange.com/questions/26193790/Importing-Calendar-files-into-Excel-ics-xls.html
03.
    ' This version require a reference to a "Microsoft ActiveX Data Objects"
04.
    
05.
    Dim filename As String
06.
    filename = Application.GetOpenFilename("Calendar Files (*.ics),*.ics")
07.
    If filename = "False" Then Exit Sub
08.
    
09.
    Dim objStream, strData
10.
    Dim r As Long, c As Long, lineCount As Long, line As String, dtStr As String, aStr As String, mlValue As String, dtArr() As String
11.
    Dim colNames As Variant
12.
    colNames = Array("DTSTART", "TIMESTART", "DTEND", "TIMEEND", "DTSTAMP", "UID", "CREATED", "DESCRIPTION", "RRULE", "LAST-MODIFIED", "LOCATION", "SEQUENCE", "STATUS", "SUMMARY", "TRANSP")
13.
    Dim EventStart As Boolean
14.
    Set objStream = CreateObject("ADODB.Stream")
15.
    
16.
    'objStream.Charset = "utf-8"
17.
    'objStream.Charset = "windows-1252"              '"_autodetect_all" ?
18.
    objStream.Charset = "_autodetect_all"
19.
    objStream.Open
20.
    objStream.Type = adTypeText
21.
    objStream.LoadFromFile (filename)
22.
    c = 0
23.
    For c = 0 To 14
24.
        Cells(1, c + 1).Value = colNames(c)
25.
        Next c
26.
    r = 2
27.
    EventStart = False
28.
    lineCount = 0
29.
    line = objStream.ReadText(adReadLine)
30.
    Do Until objStream.EOS
31.
        If Left(line, 1) <> Chr(9) Then 'Corrected a cut/paste bug " " == chr(9)
32.
        aStr = Split(line, ":")(0)
33.
        End If
34.
        If Left(line, 12) = "BEGIN:VEVENT" Then 'Die ersten Zeilen ("Header") bis zum ersten Ereignis werden ignoriert
35.
            EventStart = True
36.
        End If
37.
        If EventStart = True Then
38.
            dtStr = Replace(line, aStr & ":", "")
39.
            Select Case True
40.
                Case Left(line, 7) = "DTSTART"
41.
                    Cells(r, 1) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
42.
                    'Spalte "TIMESTART"
43.
                    Cells(r, 2) = Cells(r, 1)
44.
                Case Left(line, 5) = "DTEND"
45.
                    Cells(r, 3) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
46.
                    'Spalte "TIMEEND"
47.
                    Cells(r, 4) = Cells(r, 3)
48.
                Case Left(line, 7) = "DTSTAMP"
49.
                    Cells(r, 5) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
50.
                Case Left(line, 3) = "UID"
51.
                    Cells(r, 6) = dtStr
52.
                Case Left(line, 7) = "CREATED"
53.
                    Cells(r, 7) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
54.
                Case Left(line, 11) = "DESCRIPTION"
55.
                    Cells(r, 8) = dtStr
56.
                Case Left(line, 5) = "RRULE"
57.
                    Cells(r, 9) = dtStr
58.
                Case Left(line, 13) = "LAST-MODIFIED"
59.
                    Cells(r, 10) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")
60.
                Case Left(line, 8) = "LOCATION"
61.
                    Cells(r, 11) = dtStr
62.
                Case Left(line, 8) = "SEQUENCE"
63.
                    Cells(r, 12) = dtStr
64.
                Case Left(line, 6) = "STATUS"
65.
                    Cells(r, 13) = dtStr
66.
                Case Left(line, 7) = "SUMMARY"
67.
                    Cells(r, 14) = dtStr
68.
                Case Left(line, 6) = "TRANSP"
69.
                    Cells(r, 15) = dtStr
70.
                Case Left(line, 10) = "END:VEVENT"
71.
                    r = r + 1
72.
            End Select
73.
        Else
74.
            lineCount = lineCount + 1
75.
        End If 'EventStart
76.
        line = objStream.ReadText(adReadLine)
77.
    Loop
78.
    Cells(r + 2, 1) = lineCount & " Headerzeilen"
79.
    Columns(1).NumberFormat = "dd.mm.yyyy"
80.
    Columns(2).NumberFormat = "hh:mm:ss"
81.
    Columns(3).NumberFormat = "dd.mm.yyyy"
82.
    Columns(4).NumberFormat = "hh:mm:ss"
83.
    'eigentlich nicht notwendig:
84.
    Columns(5).NumberFormat = "yyyy-mm-dd hh:mm:ss"
85.
    Columns(7).NumberFormat = "yyyy-mm-dd hh:mm:ss"
86.
    Columns(10).NumberFormat = "yyyy-mm-dd hh:mm:ss"
87.
    Dim Spalte As Range
88.
    For Each Spalte In ActiveSheet.UsedRange.Columns
89.
        Spalte.AutoFit
90.
        Next Spalte
91.
End Sub
92.
 
93.
Function ParseDateZ(dtStr As String)
94.
    Dim dtArr() As String
95.
    Dim dt As Date
96.
    dtArr = Split(Replace(dtStr, "Z", ""), "T")
97.
    dt = DateSerial(Left(dtArr(0), 4), Mid(dtArr(0), 5, 2), Right(dtArr(0), 2))
98.
    If UBound(dtArr) > 1 Then
99.
        dt = dt + TimeSerial(Left(dtArr(1), 2), Mid(dtArr(1), 3, 2), Right(dtArr(1), 2))
100.
    End If
101.
    ParseDateZ = dt
102.
End Function
Der "Kopfteil" wird erstmal ignoriert. Dieser könnte original zwischengespeichert oder sicher auch editierbar gemacht werden.
Das Makro für den (Rück-)Export könnte ich bei Interesse auch posten.

Viel Vergnügen damit.
Peter
Bitte warten ..
Ähnliche Inhalte
Erkennung und -Abwehr
CSV-Import in Excel mit Code-Injection!
Information von LochkartenstanzerErkennung und -Abwehr3 Kommentare

Nur damit niemand denkt, da kann ja nicht viel passieren. Auch bei CSV-Dateien, sollte man genau hinsehen, wo die ...

MikroTik RouterOS

Mikrotik Zertifikate - Import von Private-Key wird ignoriert

Tipp von colinardoMikroTik RouterOS

Hallo Kollegen, kurzer Tipp für den Import von private Keys von Zertifikaten in der aktuellen RouterOS-Version. Als ich gestern ...

Windows Update

GELÖST Import u. Export - Unerwarteter Fehler vom externen Datenbanktreiber

Tipp von SnuffchenWindows Update3 Kommentare

Seit dem Microsoft Patchday am 10. Oktober 2017 ist der Import und Export von Excel-Dateien via JET-Treiber gestört. Ursache ...

Microsoft Office

Excel druckt keine Rahmen

Tipp von erikroMicrosoft Office2 Kommentare

Moin, das ist ein Problem aus der Abteilung "Vollkommen absurd". Einer unserer User beschwerte sich, dass Excel 2010 keinerlei ...

Neue Wissensbeiträge
iOS
IOS hat nen Cursor !!!
Tipp von Criemo vor 4 StundeniOS

Nette Funktion im iOS. iPhone-Mauszeiger aktivieren „Nichts ist nerviger, als bei einem Tippfehler zu versuchen, den iOS-Cursor an die ...

Off Topic
Avengers 4: Endgame - Erster Trailer
Information von Frank vor 2 TagenOff Topic1 Kommentar

Ich weiß es ist Off Topic, aber ich freue mich auf diesen Film und vielleicht geht es anderen hier ...

Webbrowser
Microsoft bestätigt Edge mit Chromium-Kern
Information von Frank vor 2 TagenWebbrowser5 Kommentare

Microsoft hat nun in seinem Blog bestätigt, dass die nächste Edge Version kein EdgeHTML mehr für die Darstellung benutzen ...

Sicherheit

MikroTik: Sicherheitslücke wird ausgenutzt obwohl ein Update seit langem verfügbar ist

Information von sabines vor 2 TagenSicherheit

Obwohl ein Update, dass die nun massenhaft ausgenutzte Lücke schließt, seit langem (März 2018) verfügbar ist, wird es offensichtlich ...

Heiß diskutierte Inhalte
Exchange Server
Exchange Server 2010: Keine Eingehenden E-MAils
Frage von gabeBUExchange Server15 Kommentare

Hallo Zusammen Ich habe das kurzen auf dem Exchange 2010 Server das Problem, dass ich keine externen E-Mails mehr ...

Rechtliche Fragen
Systemhaus auf Abwegen
Frage von rocco61Rechtliche Fragen13 Kommentare

Hallo zusammen, bin derzeit ratlos bei dem folgenden Scenario: In einen Seniorenheim wurde beschlossen, die IT an eine andere ...

Router & Routing
MikroTik - Routing, Bridging, Switching
gelöst Frage von Alex29Router & Routing9 Kommentare

Hallo in die Runde, als Hobby-Admin würde ich bitte mal wieder Eure Hilfe benötigen. Seit der Umstellung auf RouterOS ...

Outlook & Mail
Kalendersync mit Android und Outlook
Frage von Stefan007Outlook & Mail8 Kommentare

Hi Leute, kennt jemand eine Möglichkeit um Termine zwischen installiertem Outlook auf dem PC und dem Kalender auf einem ...