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
Schuwatch!
Yes, it's me. Now shut up.
Yes, it's me. Now shut up.