How to read Google Calendar events?

[Ikerkaz]

I tried making this quick and dirty parser for ICS files this morning. Maybe this will help you get a jump start. You might have to add more parts to the VEVENT type.

Code: (Select All)

Option Explicit

$NoPrefix

$Console:Only



Type VEVENT

    As String SUMMARY, LOCATION, UID, DTSTART, DTEND, SEQUENCE, STATUS, DESCRIPTION

End Type



ReDim As VEVENT events(0 To 0)

GetAllEvents "C:\Users\zspriggs\Downloads\calendar.ics", events()



Dim As Long i

For i = 0 To UBound(events)

    Print events(i).SUMMARY

    Print events(i).LOCATION

    Print events(i).DTSTART, events(i).DTEND

    Print events(i).DESCRIPTION

    Print

Next



Sub GetAllEvents (icsFile As String, vevents() As VEVENT)

    If FileExists(icsFile) Then

        Dim As Long icsHandle: icsHandle = FreeFile

        Open "B", icsHandle, icsFile

        ReDim As String eventStrings(0 To 0)

        Dim As String buf: buf = Space$(LOF(icsHandle))

        Get icsHandle, , buf

        Close icsHandle

        tokenize buf, Chr$(13) + Chr$(10), eventStrings()

        Dim As Long i, j

        For i = 0 To UBound(eventStrings)

            If InStr(eventStrings(i), "DTSTART") Or InStr(eventStrings(i), "DTEND") Then

                Select Case Mid$(eventStrings(i), 1, InStr(eventStrings(i), ";") - 1)

                    Case "DTSTART"

                        vevents(j).DTSTART = Mid$(eventStrings(i), InStr(eventStrings(i), ";") + 1)

                    Case "DTEND"

                        vevents(j).DTEND = Mid$(eventStrings(i), InStr(eventStrings(i), ";") + 1)

                End Select

            Else

                Select Case Mid$(eventStrings(i), 1, InStr(eventStrings(i), ":") - 1)

                    Case "SUMMARY"

                        vevents(j).SUMMARY = String.Replace(Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1), "\n", Chr$(10))

                        If Left$(eventStrings(i + 1), 1) = " " Then

                            Dim As Long k: k = i + 1

                            Do

                                vevents(j).SUMMARY = vevents(j).SUMMARY + String.Replace(Mid$(eventStrings(k), 2), "\n", Chr$(10))

                                k = k + 1

                            Loop Until Left$(eventStrings(k), 1) <> " "

                        End If

                    Case "LOCATION"

                        vevents(j).LOCATION = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "UID"

                        vevents(j).UID = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "SEQUENCE"

                        vevents(j).SEQUENCE = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "STATUS"

                        vevents(j).STATUS = Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1)

                    Case "DESCRIPTION"

                        vevents(j).DESCRIPTION = String.Replace(Mid$(eventStrings(i), InStr(eventStrings(i), ":") + 1), "\n", Chr$(10))

                        If Left$(eventStrings(i + 1), 1) = " " Then

                            Dim As Long l: l = i + 1

                            Do

                                vevents(j).DESCRIPTION = vevents(j).DESCRIPTION + String.Replace(Mid$(eventStrings(l), 2), "\n", Chr$(10))

                                l = l + 1

                            Loop Until Left$(eventStrings(l), 1) <> " "

                        End If

                End Select

            End If

            If eventStrings(i) = "END:VEVENT" Then

                j = j + 1

                ReDim Preserve vevents(0 To j) As VEVENT

            End If

        Next

    End If

End Sub



Function String.Replace$ (instring As String, searchString As String, replaceWith As String)

    Dim As Single j

    Dim As String outstring

    j = InStr(instring, searchString)

    If j > 0 Then

        outstring = Left$(instring, j - 1) + replaceWith + String.Replace(Right$(instring, Len(instring) - j + 1 - Len(searchString)), searchString, replaceWith)

    Else

        outstring = instring

    End If

    String.Replace = outstring

End Function



Function pointerToString$ (pointer As _Offset)

    Declare CustomType Library

        Function strlen%& (ByVal ptr As _Unsigned _Offset)

    End Declare

    Dim As _Offset length: length = strlen(pointer)

    If length Then

        Dim As _MEM pString: pString = _Mem(pointer, length)

        Dim As String ret: ret = Space$(length)

        _MemGet pString, pString.OFFSET, ret

        _MemFree pString

    End If

    pointerToString = ret

End Function



Sub tokenize (toTokenize As String, delimiters As String, StorageArray() As String)

    Declare CustomType Library

        Function strtok%& (ByVal str As _Offset, delimiters As String)

    End Declare

    Dim As _Offset tokenized

    Dim As String tokCopy: If Right$(toTokenize, 1) <> Chr$(0) Then tokCopy = toTokenize + Chr$(0) Else tokCopy = toTokenize

    Dim As String delCopy: If Right$(delimiters, 1) <> Chr$(0) Then delCopy = delimiters + Chr$(0) Else delCopy = delimiters

    Dim As _Unsigned Long lowerbound: lowerbound = LBound(StorageArray)

    Dim As _Unsigned Long i: i = lowerbound

    tokenized = strtok(_Offset(tokCopy), delCopy)

    While tokenized <> 0

        ReDim _Preserve StorageArray(lowerbound To UBound(StorageArray) + 1)

        StorageArray(i) = pointerToString(tokenized)

        tokenized = strtok(0, delCopy)

        i = i + 1

    Wend

    ReDim _Preserve StorageArray(UBound(StorageArray) - 1)

End Sub

Thank you very much.
I downloaded ICS from my current Google calendar, and tried with this code, but it does not work.
It crashes in the GetAllEvents sub, it exits with no error screen