Enable autoreply with certain date for Outlook

This VBA code is in Excel. The version is Office 365.

The error raised is

Type mismatch

in SetProperty xxxxx0X661E001F and also 0x661F0040.

I tried to change the strMessge to variant or change to UNICODE.

Option Explicit

Sub SetAutoReply()

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.Namespace
    Dim objStore As Outlook.Store
    Dim objPropertyAccessor As Outlook.propertyAccessor
    Dim strStartDate As String, strEndDate As String
    Dim dtStartDate As Date, dtEndDate As Date
    Dim strMessage As String

    ' Set the auto-reply start and end dates and times
    dtStartDate = "05/16/2023 08:00:00" ' Set the start date and time (MM/DD/YYYY HH:MM:SS)
    dtEndDate = "05/16/2023 17:00:00" ' Set the end date and time (MM/DD/YYYY HH:MM:SS)
    strMessage = "I am currently out of the office and will return on [end_date]."

    ' Initialize Outlook
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    ' Get the default mailbox
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objStore = objNamespace.DefaultStore
    Set objPropertyAccessor = objStore.PropertyAccessor

    ' Set the auto-reply settings
    With objPropertyAccessor
        strStartDate = Format(dtStartDate, "yyyy-mm-dd\THH:MM:ss")
        strEndDate = Format(dtEndDate, "yyyy-mm-dd\THH:MM:ss")
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661D000B", True 'Enable auto-reply
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661E001F", strMessage 'Set auto-reply message
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661F0040", strStartDate 'Set auto-reply start date
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x66230040", strEndDate 'Set auto-reply end date
    End With

    ' Release the objects
    Set objPropertyAccessor = Nothing
    Set objStore = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing

    MsgBox "Auto-reply has been set from " & dtStartDate & " to " & dtEndDate & ".", vbInformation, "Auto-reply Set"

End Sub

Solution

The last two properties (0x661F0040 and 0x66230040) are of PT_SYSTIME type (0x0040), therefore you must pass a DateTime value, not a string. It is your responsibility to convert your data to the right type. In this particular case, use CDate function:

.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661F0040", CDate(strStartDate) 'Set auto-reply start date
.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x66230040", CDate(strEndDate) 'Set auto-reply end date

If you are setting OOF state and range, keep in mind that it cannot be set using MAPI, you need to use EWS for that.