I have been using the slightly ammended code below which I found online. A problem with this is that the end dates are a day out.
Reason being, all day events end at midnight. The time 00.00 registers as the next day. So thats the issue im looking to resolve at the moment.
As a way for me to improve my understanding, what are: .subject .end .start .categories? What would I call these? So I can better search/understand my problem. A list of all these "properties?" would be greatbut I can't find any online.
Sub Workbook_Open() On Error GoTo ErrHand: Application.ScreenUpdating = False 'This is an enumeration value in context of getDefaultSharedFolder Const olFolderCalendar As Byte = 9 Dim olapp As Object: Set olapp = CreateObject("Outlook.Application") Dim olNS As Object: Set olNS = olapp.GetNamespace("MAPI") Dim olfolder As Object Dim olApt As Object: Set olNS = olapp.GetNamespace("MAPI") Dim objOwner As Object: Set objOwner = olNS.CreateRecipient("[email protected]") Dim NextRow As Long Dim olmiarr As Object Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") ''''''''''''''''test code''''''''''''''''' ''''''''''''''''test code''''''''''''''''' objOwner.Resolve If objOwner.Resolved Then Set olfolder = olNS.GetSharedDefaultFolder(objOwner, olFolderCalendar) End If ws.Range("A1:D1").Value2 = Array("Subject", "Start", "End", "Category") 'Ensure there at least 1 item to continue If olfolder.items.Count = 0 Then Exit Sub 'Create an array large enough to hold all records Dim myArr() As Variant: ReDim myArr(0 To 3, 0 To olfolder.items.Count - 1) 'Add the records to an array 'Add this error skip, as I found some of my calendar items don't have all properties e.g. a start time On Error Resume Next For Each olApt In olfolder.items myArr(0, NextRow) = olApt.Subject myArr(1, NextRow) = olApt.Start myArr(2, NextRow) = olApt.End myArr(3, NextRow) = olApt.Categories NextRow = NextRow + 1 Next On Error GoTo 0 'Write all records to a worksheet from an array, this is much faster ws.Range("A2:D" & NextRow + 1).Value = WorksheetFunction.Transpose(myArr) 'AutoFit ws.Columns.AutoFit cleanExit: Application.ScreenUpdating = True Exit Sub ErrHand: 'Add error handler Resume cleanExit End Sub