ICS import zu exel

[Carsten-Wählisch]

Hallo 
Ich benötige Hilfe 
Ich habe einen VBA Code für ICS import zu exel.
Meine ICS Datei ist aus einem Google Kalender.
Mein Problem ist die Zeit. Sie wird mir nur als 0:00:00
Angezeigt.

Was ist mein Fehler.

Sub ICS_Import()
    ' modifiziert nach: https://www.experts-exchange.com/questio...s-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©
        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:mms")  
                    'Spalte "TIMESTART"  
                    Cells(r, 2) = Cells(r, 1)
                Case Left(line, 5) = "DTEND"  
                    Cells(r, 3) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mms")  
                    'Spalte "TIMEEND"  
                    Cells(r, 4) = Cells(r, 3)
                Case Left(line, 7) = "DTSTAMP"  
                    Cells(r, 5) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mms")  
                Case Left(line, 3) = "UID"  
                    Cells(r, 6) = dtStr
                Case Left(line, 7) = "CREATED"  
                    Cells(r, 7) = Format(ParseDateZ(dtStr), "yyyy-mm-dd hh:mms")  
                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:mms")  
                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:mms"  
    Columns(3).NumberFormat = "dd.mm.yyyy"  
    Columns(4).NumberFormat = "hh:mms"  
    'eigentlich nicht notwendig:  
    Columns(5).NumberFormat = "yyyy-mm-dd hh:mms"  
    Columns(7).NumberFormat = "yyyy-mm-dd hh:mms"  
    Columns(10).NumberFormat = "yyyy-mm-dd hh:mms"  
    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