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, 492 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

Dezember-Update blockiert Excel-Makro

Tipp von 10000ragaMicrosoft Office8 Kommentare

Hallo, haben Probleme mit Excel Makros gehabt. ( Laufzeitfehler 438 bei uns) ( Excel 2010) Problem Behebung Quelle ( ...

Neue Wissensbeiträge
Peripheriegeräte
Unterschrank für HP Drucker
Tipp von NixVerstehen vor 1 TagPeripheriegeräte1 Kommentar

Als kurzen Freitags-Tipp möchte ich gerne meinen neuen Drucker-Unterschrank Modell Amica KS 15423W vorstellen. Das Gerät eignet sich hervorragend ...

Windows 10
Windows 10 - Probleme mit Point-And-Print
Tipp von emeriks vor 2 TagenWindows 103 Kommentare

Hi, wir kämpfen z.Z. mit einigen Druckertreibern, welche unter Win10 beim Verbinden eines Druckers von Printserver mit dem Dialog ...

Windows 10

Windows 10 1803 - Ihr Roamingbenutzerprofil wurde nicht vollständig synchronisiert

Anleitung von Deepsys vor 2 TagenWindows 101 Kommentar

Bei allen Windows 10 1803 PCs traten Probleme mit den Servergespeicherten Profilen auf. Das Abmelden dauerte sehr lange und ...

Exchange Server
Exchange - Fehler mit 2018-07 Sicherheitsupdate
Tipp von ArnoNymous vor 4 TagenExchange Server7 Kommentare

Hallo, es gibt mal wieder Freude mit den MS-Updates. KB4338814 führt dazu, dass der Exchange keine Mails mehr zustellt. ...

Heiß diskutierte Inhalte
Humor (lol)
Freitagsfrage: Was tun, wenn der Admin der DAU ist?
gelöst Frage von VoiperHumor (lol)32 Kommentare

Moin Zusammen, Eine nicht ganz ernst gemeinte Frage an die Außendienstler unter uns. Zusammenfassung: Ein Inhouse Admin ruft bei ...

LAN, WAN, Wireless
HP Probook 470 G4 - abbrechende Downloads
Frage von joern1LAN, WAN, Wireless19 Kommentare

Folgendes Problem, für einen Tipp wäre ich dankbar: Bei WLAN-Verbindung zum Internet (nicht LAN) kommt es bei etwas größeren ...

Windows Netzwerk
LTE Modul - Kein Internet trotz Verbindung
Frage von killtecWindows Netzwerk19 Kommentare

Hallo, ich habe hier ein Dell 7390 2-in-1 mit W10 Pro wo ich nachträglich eine LTE-Karte (Original Dell DW5811e ...

Router & Routing
Routing Problem mit Kaskade FritzBox und pfsense zugeriff nur von der firewall auf die clients und 0.0.0.0
Frage von ukl1967Router & Routing17 Kommentare

Hallo, ich habe ein an sich triviales Problem elches ich allerdings nicht gelöst bekomme. NAS 10.5.10.53 Mein Netz baut ...