'VBS: Set Out of Office replies in Outlook with start date and end date

I am working on a script to automate OOO in Outlook by reading an MS Excel sheet.

The script reads start date and end date from an input spreadsheet and then sets the out of office replies in Outlook for those dates.
This script gets the current date, and if the start date read from the spreadsheet is tomorrow's date, then it will prompt the user.
The idea is to remind the user to set OOO and then automatically set it upon user's confirmation. For example, if the start date and end date from the excel sheet are 21-Oct-2016 and 24-Oct-2016 and if this script is run on 20-Oct-2016, it should be able to set the OOO starting 21-Oct-2016 till 24-Oct-2016 automatically (without having to open MS Outlook)
So far, I am able to read the spreadsheet and get the dates. However, I am not able to set OOO for a future period.

Here's the code in progress:

Sub ReadDataAndSetOOO()

    Dim objExcel,ObjWorkbook,objsheet
    intRow = 2
    Dim startDateValue, endDateValue
    Set objExcel = CreateObject("Excel.Application")
    Set objWorkbook = objExcel.Workbooks.Open("C:\input.xlsx")
    set objsheet = objExcel.ActiveWorkbook.Worksheets(1)

    DateToday = FormatDateTime(Date, 1)
    DateTomorrow = formatDate(FormatDateTime(DateAdd("d", 1, DateToday), 1))
    Wscript.Echo DateTomorrow

    Do Until objExcel.Cells(intRow,1).Value = ""
        startDateValue = formatDate(FormatDateTime(objsheet.Cells(intRow,1).value,1))
        endDateValue = formatDate(FormatDateTime(objsheet.Cells(intRow,2).value))

        Wscript.Echo "Start date=" & startDateValue
        Wscript.Echo "End date=" & endDateValue
        If DateTomorrow = startDateValue Then
            'Following line to be replaced by the code to set OOO between start and end date
            Wscript.Echo "I am on leave from " & startDateValue & " to " & endDateValue 
        End If  
        intRow = intRow + 1
    Loop
    objExcel.ActiveWorkbook.Close
    objExcel.Workbooks.Close
    objExcel.Application.Quit
End Sub

Function formatDate(myDate)
    d = parse(Day(myDate))
    m = parse(Month(myDate))    
    y = Year(myDate)
    formatDate= d & "-" & m & "-" & y
End Function

Function parse(num)
    If(Len(num)=1) Then
        parse="0"&num
    Else
        parse=num
    End If
End Function

ReadDataAndSetOOO

I referred to this link and some other links, but everywhere, OOO is set immediately and not for required start and end dates.

Any pointers are appreciated.

Solution 1:^[1]

OOF time range can only be set through EWS, namely using the UserOofSettings verb. It cannot be set using Outlook Object Model or Extended MAPI.

If using Redemption is an option (I am its author), it exposes the RDOOutOfOfficeAssistant object. Since it performs an EWS call, it will need the credentials of the mailbox user.

     set Session = CreateObject("Redemption.RDOSession")
     Session.MAPIOBJECT = Application.Session.MAPIOBJECT
     Session.Credentials.Add "*.myserver.com", "Domain\UserName", "MyPassword"
     set OofAssistant = Session.Stores.DefaultStore.OutOfOfficeAssistant
     OofAssistant.BeginUpdate
     OofAssistant.StartTime = #12/21/2011#
     OofAssistant.EndTime = #01/03/2012 9:00#
     OofAssistant.State = 2 'rdoOofScheduled
     OofAssistant.ExternalAudience = 1 'rdoOofAudienceKnown
     OofAssistant.OutOfOfficeTextInternal = "<html><body>I am on vacation from 12/21/2001 until 01/03/2012. Please contact " & _
           "<a href=""mailto:[email protected]"">Joe User</a>" & _
           " if you have any questions</body></html>"
     OofAssistant.OutOfOfficeTextExternal = "<html><body>I am on <b>vacation</b> until next year. </body></html>"
     OofAssistant.EndUpdate

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution	Source
Solution 1

'VBS: Set Out of Office replies in Outlook with start date and end date

Solution 1:[1]

Sources

Related Questions

Solution 1:^[1]