Unable to determine "all day events"

[Homegrownandy]

I'm using the code below but have an issue with this line:

    myArr(4, NextRow) = olApt.AllDayEvent

Im using this property basaed on the information here: https://docs.microsoft.com/en-us/off...ent-properties

It will always return N/A. I need to determin if its an all day event i am exporting so I can take 1 day off the end date. (all day events finish at midnight and the system will count this as two days.).

would anyone have any ideas for this?

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("andrew.holme@ramptec.co.uk")
    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", "All_Day_Event")
    '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
        myArr(4, NextRow) = olApt.AllDayEvent
        
        NextRow = NextRow + 1
    Next
    On Error GoTo 0

    'Write all records to a worksheet from an array, this is much faster
    ws.Range("A2:E" & NextRow + 1).Value = WorksheetFunction.Transpose(myArr)

    'AutoFit
    ws.Columns.AutoFit

cleanExit:
    Application.ScreenUpdating = True
    Exit Sub

ErrHand:
    'Add error handler
    Resume cleanExit
End Sub

[Gicu]

Do you get the proper Start/End values (12 AM for both)?
Cheers,

[Homegrownandy]

Thanks for your reply. Not always. Sometimes it's just the date sometimes it does have a time also. I'll look into formatting this also to just have the date.

[Homegrownandy]

Ive attached a screenshot of some test data. It seems the all day events don't have a time.

[Bulzie]

Could you use DateDiff somehow to check minutes between those fields?

If DateDiff("n",Start, End) >= 1440 Then...

[Gicu]

How about using something like this to identify them:

myArr(4, NextRow) = IIf(olApt.Start=datevalue(olApt.Start) And olApt.End=datevalue(olApt.End) ,True,False)

Cheers,

[CJ_London]

suggest format your date columns to include the time element as well - it could be date only is just showing the datepart. Also concerned some dates are right justified and others left which implies a mix of date and text datatypes

[Bullschmidt]

Could you use DateDiff somehow to check minutes between those fields?
If DateDiff("n",Start, End) >= 1440 Then...

And adding to that since it looks like the Start and End fields are text instead of dates (with non-US styled dates such as 29/05/2019 shown left justified and with all dates having 10 characters)...
If DateDiff("n",Left(Start,10), Left(End,10)) >= 1440 Then...