04.07.2018, aktualisiert am 01.04.2024

32636

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.

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.

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 379164

Url: https://administrator.de/contentid/379164

Ausgedruckt am: 19.11.2024 um 06:11 Uhr

18 Kommentare

Neuester Kommentar

Ich sag Dir mal herzlichen Dank dafür.
Es ist schön, wenn Kollegen ihr Wissen teilen.

Das freut mich.

Gruß Peter

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.

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, lineCount As Long, line As String, dtStr As String, aStr As String, mlValue As String, dtArr() As String
    Dim colNames As Variant
    colNames = Array("DTSTART", "TIMESTART", "DTEND", "TIMEEND", "DTSTAMP", "UID", "CREATED", "DESCRIPTION", "RRULE", "LAST-MODIFIED", "LOCATION", "SEQUENCE", "STATUS", "SUMMARY", "TRANSP")  
    Dim EventStart As Boolean
    Set objStream = CreateObject("ADODB.Stream")  
    
    'objStream.Charset = "utf-8"  
    'objStream.Charset = "windows-1252"              '"_autodetect_all" ?  
    objStream.Charset = "_autodetect_all"  
    objStream.Open
    objStream.Type = adTypeText
    objStream.LoadFromFile (filename)
    c = 0
    For c = 0 To 14
        Cells(1, c + 1).Value = colNames(c)
        Next c
    r = 2
    EventStart = False
    lineCount = 0
    line = objStream.ReadText(adReadLine)
    Do Until objStream.EOS
        If Left(line, 1) <> Chr(9) Then 'Corrected a cut/paste bug " " == chr(9)  
        aStr = Split(line, ":")(0)  
        End If
        If Left(line, 12) = "BEGIN:VEVENT" Then 'Die ersten Zeilen ("Header") bis zum ersten Ereignis werden ignoriert  
            EventStart = True
        End If
        If EventStart = True Then
            dtStr = Replace(line, aStr & ":", "")  
            Select Case True
                Case Left(line, 7) = "DTSTART"  
                    Cells(r, 1) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")  
                    'Spalte "TIMESTART"  
                    Cells(r, 2) = Cells(r, 1)
                Case Left(line, 5) = "DTEND"  
                    Cells(r, 3) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")  
                    'Spalte "TIMEEND"  
                    Cells(r, 4) = Cells(r, 3)
                Case Left(line, 7) = "DTSTAMP"  
                    Cells(r, 5) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")  
                Case Left(line, 3) = "UID"  
                    Cells(r, 6) = dtStr
                Case Left(line, 7) = "CREATED"  
                    Cells(r, 7) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")  
                Case Left(line, 11) = "DESCRIPTION"  
                    Cells(r, 8) = dtStr
                Case Left(line, 5) = "RRULE"  
                    Cells(r, 9) = dtStr
                Case Left(line, 13) = "LAST-MODIFIED"  
                    Cells(r, 10) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mm:ss")  
                Case Left(line, 8) = "LOCATION"  
                    Cells(r, 11) = dtStr
                Case Left(line, 8) = "SEQUENCE"  
                    Cells(r, 12) = dtStr
                Case Left(line, 6) = "STATUS"  
                    Cells(r, 13) = dtStr
                Case Left(line, 7) = "SUMMARY"  
                    Cells(r, 14) = dtStr
                Case Left(line, 6) = "TRANSP"  
                    Cells(r, 15) = dtStr
                Case Left(line, 10) = "END:VEVENT"  
                    r = r + 1
            End Select
        Else
            lineCount = lineCount + 1
        End If 'EventStart  
        line = objStream.ReadText(adReadLine)
    Loop
    Cells(r + 2, 1) = lineCount & " Headerzeilen"  
    Columns(1).NumberFormat = "dd.mm.yyyy"  
    Columns(2).NumberFormat = "hh:mm:ss"  
    Columns(3).NumberFormat = "dd.mm.yyyy"  
    Columns(4).NumberFormat = "hh:mm:ss"  
    'eigentlich nicht notwendig:  
    Columns(5).NumberFormat = "yyyy-mm-dd hh:mm:ss"  
    Columns(7).NumberFormat = "yyyy-mm-dd hh:mm:ss"  
    Columns(10).NumberFormat = "yyyy-mm-dd hh:mm:ss"  
    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

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

Mal ne Frage dazu:

Ist es Umsetzbar aus einer Exceldatei oder vielleicht eine CSV mit Terminen daraus ein ein Makro (VBA)zun erstellen,das ICAL Dateien erstellt ?

Und als i Tüpfelchen: Mehrer ICAL Dateien pro Person je nachdem wie viel Personen hier in der Ursprungsdatei stehen ?!?

Natürlich geht das.
Erstmal dein erstes Problem.

Betrifft hier eine Tabelle mit den Spalten

Sub ICS_Export()
Dim strDateiname As String
Dim strDateinameZusatz As String
Dim strMappenpfad As String
Dim intCutExt

'Datename ohne Ext. (nach Punkt suchen):  
intCutExt = Len(ActiveWorkbook.Name) - InStrRev(ActiveWorkbook.Name, ".") + 1  
strMappenpfad = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - intCutExt)

'strDateinameZusatz = "-" & Year(ActiveSheet.Cells(3, 1).Value) & "-" & Month(ActiveSheet.Cells(3, 1).Value) & ".ics"  
strDateinameZusatz = "-" & Format(Now, "YYYY-MM-DD-HH-MM-SS") & ".ics"  

strDateiname = InputBox("Bitte den Namen der ICS-Datei angeben.", "ICS-Export", strMappenpfad & strDateinameZusatz)  
If strDateiname = "" Then Exit Sub  

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(strDateiname, True)

'Schreibt den allgemeinen Teils der Kalenderdatei  
    a.writeline ("BEGIN:VCALENDAR")  
    a.writeline ("CALSCALE:GREGORIAN")  
    a.writeline ("VERSION:2.0")  
    a.writeline ("PRODID:-//Private/NONSGML ExcelExportToICS//DE")  
    a.writeline ("METHOD:PUBLISH")  
    a.writeline ("X-WR-CALNAME:ExcelExportToICS")  
    a.writeline ("X-WR-TIMEZONE:Europe/Berlin")  
    a.writeline ("BEGIN:VTIMEZONE")  
    a.writeline ("TZID:Europe/Berlin")  
    a.writeline ("X-LIC-LOCATION:Europe/Berlin")  
    
    a.writeline ("BEGIN:DAYLIGHT")  
    a.writeline ("DTSTART:19700329T020000")  
    a.writeline ("RRULE:BYMONTH=3;FREQ=YEARLY;BYDAY=-1SU")  
    a.writeline ("TZNAME:CEST")  
    a.writeline ("TZOFFSETFROM:+0100")  
    a.writeline ("TZOFFSETTO:+0200")  
    a.writeline ("END:DAYLIGHT")  
    
    a.writeline ("BEGIN:STANDARD")  
    a.writeline ("DTSTART:19701025T030000")  
    a.writeline ("RRULE:BYMONTH=10;FREQ=YEARLY;BYDAY=-1SU")  
    a.writeline ("TZNAME:CET")  
    a.writeline ("TZOFFSETFROM:+0200")  
    a.writeline ("TZOFFSETTO:+0100")  
    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)
    '(<PB)  
    Dim datstart1 As Date
    datstart1 = datstart + 1
    '(PB>)  
    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 text As String
    text = ActiveCell.Offset(i, 6)
    
    '(<PB) Wert zur Festlegung ganztägiger Ereignisse  
    Dim allday As Boolean
    allday = ActiveCell.Offset(i, 7)
    '(PB>)  
    
'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)
    '(<PB)  
    Dim jdatstart1 As String
    jdatstart1 = Year(datstart1)
    Dim mdatstart1 As String
    mdatstart1 = Month(datstart1)
    If mdatstart1 < 10 Then mdatstart1 = "0" + mdatstart1  
    Dim tdatstart1 As String
    tdatstart1 = Day(datstart1)
    '(PB>)  
    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 + "-ExcelExport-" + k)  
    a.writeline ("CLASS:PUBLIC")  
    a.writeline ("SUMMARY:" + thema)  
    a.writeline ("DESCRIPTION:" + text)  
    a.writeline ("LOCATION:" + ort)  
    
    'Die Datumsinformationen sind nach der RFC 2445 für das iCalendar Format als UTC angegeben (enden mit einem "Z")  
    
    '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 ("DTSTART:" + jdatstart + mdatstart + tdatstart + "T" + hhtimestart + mmtimestart + sstimestart + "Z")  
    'a.writeline ("DTEND:" + jdatend + mdatend + tdatend + "T" + hhtimeend + mmtimeend + sstimeend + "Z")  
    
    '(<PB)  
    If allday Then
        a.writeline ("DTSTART;VALUE=DATE:" + jdatstart + mdatstart + tdatstart)  
        a.writeline ("DTEND;VALUE=DATE:" + jdatstart1 + mdatstart1 + tdatstart1)  
        Else
        '(PB>)  
        a.writeline ("DTSTART:" + jdatstart + mdatstart + tdatstart + "T" + hhtimestart + mmtimestart + sstimestart)  
        a.writeline ("DTEND:" + jdatend + mdatend + tdatend + "T" + hhtimeend + mmtimeend + sstimeend)  
        '(<PB)  
        End If
        '(PB>)  
    a.writeline ("DTSTAMP:" + zeitstempel)  
    a.writeline ("LAST-MODIFIED:" + zeitstempel)  
    a.writeline ("BEGIN:VALARM")  
    a.writeline ("ACTION:DISPLAY")  
    a.writeline ("TRIGGER;VALUE=DURATION:-P1D")  
    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")  
    
MsgBox "Export erfolgreich. Datei wurde exportiert nach" & vbCrLf & strDateiname  
End Sub

Das Grundprinzip wirst du am Code erkennen.
Eventuell mußt Du es Deinen Bedürfnissen anpassen.

Gruß
Peter

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

Microsoft ActiveX Data Objects 2.8 Library und
Microsoft ActiveX Data Objects Recordset 2.8 Library
müssen referenziert sein (oder aktuellere Versionen).
How to use ADODB.Connection

Gruß
Peter

Danke. Das Makro hilft sehr. Hat sich schon mal jemand die mühe gemacht und auch die "Regeln" inkl. Ausnahmen in einem Makro verarbeitet?
Freundlich Grüsse

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

Muß ich mich erst wieder reinfitzen.
Wird nicht gleich heute oder morgen.
Sorry

Trotzdem schonmal danke. Vielleicht noch nützlich zu erwähnen, dass ich als .ics Datei die Schulferien 2024 von BaWü von Schulferien.org gewählt hatte.

Nur mal als Tipp.
Stimmt die Architektur (x86 / x64) auch für Dein Office und die Microsoft ActiveX Data Objects Bibliotheken?
Fiel mir jetzt spontan ein.

Gruß
Peter

Hm, Hard- und Software sind alle 64 bit. Wenn ich das Office (365) mit x64 Architektur verwende, sind es dann die Active-X Bibliotheken nicht automatisch auch?

Gruß

Du hast Recht.

Für Dich habe ich jetzt extra schnell eine neue Excel-Datei erstellt, das Makro reingeschrieben (in unveränderter Fassung, s.o.) und nochmal die Verweise
Microsoft ActiveX Data Objects 2.8 Library und
Microsoft ActiveX Data Objects Recordset 2.8 Library

aktiviert.
Mit der Datei "ferien_sachsen_2024.ics" von ferienwiki.de läuft das Makro fehlerfrei durch.
Der Makro-Text wird in Entwicklertools - Makros - Makroname eintragen - Bearbeiten eingefügt, gespeichert als xlsm-Datei, und im VBA-Editor per grünem Startpfeil oder über Makro-Menü gestartet.

Mehr fällt mir dazu nicht ein.
Sorry

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!

Gern geschehen.
Gruß
Peter

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

Tipp VB for Applications Entwicklung

Mehr von PeterleB

Geschwindigkeit USB-ControllerPeterleB - 19 Kommentare

Kühlung externe FestplattePeterleB - 13 Kommentare

Adaptec Raid 6805 Temperaturanzeige der Laufwerke "not supported"PeterleB - 8 Kommentare

Microsoft ODBC Driver 17 for SQL ServerPeterleB - 4 Kommentare

Heiß diskutiert