Exporting entries from shared calendar - recurring appointments original start date

I've read this around a few places but no one seems to have solved it. When you are exporting from shared calendars, any recurring appointments give you back the start date of the ORIGINAL appointment, not the one you are looking at. Has anyone resolved this?

E.g following code prompts me to give a date range, and I might put in 4/4/2020 to 7/4/2020. It exports all of the calendar appointments in that range, but if any of those appointments are from a recurring series, it will set the start date to say 4/4/2019. Obviously I want the current appointment, not the original start date. Help!

Sub ExportAppointmentsToExcel()
'On the next line, edit the list of calendars you want to export. Entries are separated by a comma.
Const CAL_LIST = "sharedperson"
'On the next line, edit the path to and name of the Excel spreadsheet to export to
'Const EXCEL_FILE = "D:\Users\me\cal_export.xlsx"
Const SCRIPT_NAME = "Export Appointments to Excel (Rev 2)"
Const xlAscending = 1
Const xlYes = 1
Dim olkFld As Object, _
olkLst As Object, _
olkRes As Object, _
olkApt As Object, _
olkRec As Object, _
olkOwn As Outlook.Recipient, _
excApp As Object, _
excWkb As Object, _
excWks As Object, _
lngRow As Long, _
lngCnt As Long, _
strFil As String, _
strLst As String, _
strDat As String, _
datBeg As Date, _
datEnd As Date, _
arrTmp As Variant, _
arrCal As Variant, _
varCal As Variant
strDat = InputBox("Enter the date range of the appointments to export in the form ""mm/dd/yyyy to mm/dd/yyyy""", SCRIPT_NAME, Date & " to " & Date)
arrTmp = Split(strDat, "to")
datBeg = IIf(IsDate(arrTmp(0)), arrTmp(0), Date) & " 12:00am"
datEnd = IIf(IsDate(arrTmp(1)), arrTmp(1), Date) & " 11:59pm"
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add()
Set excWks = excWkb.Worksheets(1)
'Write Excel Column Headers
With excWks
.Cells(1, 1) = "Calendar"
.Cells(1, 2) = "Category"
.Cells(1, 3) = "Subject"
.Cells(1, 4) = "Starting Date"
.Cells(1, 5) = "Hours"
.Cells(1, 6) = "Attendees"
.Cells(1, 6) = "StarttZ"
End With
lngRow = 2
arrCal = Split(CAL_LIST, ",")
For Each varCal In arrCal
Set olkOwn = Session.CreateRecipient(CStr(varCal))
olkOwn.Resolve
If olkOwn.Resolved Then
Set olkFld = Session.GetSharedDefaultFolder(olkOwn, olFolderCalendar)
If olkFld.DefaultItemType = olAppointmentItem Then
Set olkLst = olkFld.Items
olkLst.Sort "[Start]"
olkLst.IncludeRecurrences = True
Set olkRes = olkLst.Restrict("[Start] >= '" & Format(datBeg, "ddddd h:nn AMPM") & "' AND [Start] <= '" & Format(datEnd, "ddddd h:nn AMPM") & "'")
'Write appointments to spreadsheet
For Each olkApt In olkRes
'Only export appointments
If olkApt.Class = olAppointment Then
strLst = ""
For Each olkRec In olkApt.Recipients
strLst = strLst & olkRec.Address & ", "
Next
If strLst <> "" Then strLst = Left(strLst, Len(strLst) - 2)
'Add a row for each field in the message you want to export
excWks.Cells(lngRow, 1) = varCal
excWks.Cells(lngRow, 2) = olkApt.Categories
excWks.Cells(lngRow, 3) = olkApt.Subject
excWks.Cells(lngRow, 4) = Format(olkApt.Start, "mm/dd/yyyy")
excWks.Cells(lngRow, 5) = DateDiff("n", olkApt.Start, olkApt.End) / 60
excWks.Cells(lngRow, 6) = strLst
lngRow = lngRow + 1
lngCnt = lngCnt + 1
End If
Next
Else
MsgBox "Operation cancelled. The selected folder is not a calendar. You must select a calendar for this macro to work.", vbCritical + vbOKOnly, SCRIPT_NAME
End If
Else
MsgBox "I could not find a recipient named " & varCal & ". Calendar skipped. I will continue processing the remaining calendars.", vbExclamation + vbOKOnly, SCRIPT_NAME
End If
Next
excWks.Columns("A:I").AutoFit
excWks.Range("A1:I" & lngRow - 1).Sort Key1:="Starting Date", Order1:=xlAscending, Header:=xlYes
excWks.Cells(lngRow, 8) = "=sum(H2:H" & lngRow - 1 & ")"
excWkb.SaveAs EXCEL_FILE
excWkb.Close
MsgBox "Process complete. I exported a total of " & lngCnt & " appointments were exported.", vbInformation + vbOKOnly, SCRIPT_NAME
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
Set olkOwn = Nothing
Set olkApt = Nothing
Set olkLst = Nothing
Set olkFld = Nothing
End Sub