Solved

Reoccurring Out-of-Office

Posted on 2014-03-24
6
856 Views
Last Modified: 2014-05-03
Hello all,

This is in reference to article: http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/A_3487-Automating-Out-of-Office-in-Outlook.html

I am trying to set up Outlook to check what day of the week tomorrow would be and turn on out of office during 8am-5pm that day, if it was a specific day.

Example: Every Monday at the end of the day, Outlook would set the OOO for business hours on Tuesday - (This would be helpful for a part-timer that doesn't work on Tuesday's).

This employee's messages are vital to the business and would wouldn't want to risk them forgetting to turn it on for our customers.
0
Comment
Question by:Guy-in-Transition
  • 2
6 Comments
 
LVL 9

Expert Comment

by:Trenton Knew
ID: 39951847
Delegate another user to that employee's mailbox so someone can fetch messages from their mailbox anytime
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 39967396
Hi, Guy-in-Transition.

I wrote the article you linked to.  The code in that article depends on CDO which is not supported under Outlook 2010 and later.  For that reason, I've created a new version that should work under outlook 2007 and later.  This version also runs from outside of Outlook, which will allow you to schedule it.  

Follow these instructions to use this solution.

1.  Open Notepad
2.  Copy the code below and paste it into Notepad
3.  Save the file.  You can name it anything you like, but the extension must be .vbs
4.  Using Windows task scheduler, create a task schedule to run at the end of the day
5.  Set the task to run the script saved in step #3.  The script takes two named parameters: State and Message.  The format of the command line will be something like this.

To turn out of office on and set a message

wscript.exe Out-of-Office.vbs /State:on /Message:"I am out of the office until tomorrow morning at 7:00am"

To turn out of office off

wscript.exe Out-of-Office.vbs /State:off

This solution has to run at a computer with Outlook installed.  It is not designed to run at the Exchange server.

'--> Define some constants
	Const olPrimaryExchangeMailbox = 0
	Const olIdentifyByMessageClass = 2
	Const olFolderInbox = 6
	Const PR_OOF_STATE = "http://schemas.microsoft.com/mapi/proptag/0x661D000B"

'--> Define some variables
	Dim strVer, olkApp, olkSes, colArg, strSta, strMsg, bolSta
	
'--> Get the arguments from the command line
	Set colArg = WScript.Arguments.Named
	strSta = colArg.Item("State")
	strMsg = colArg.Item("Message")
	Select Case LCase(strSta)
		Case "on","out","true"
			bolSta = True
		Case Else
			bolSta = False
	End Select
	If strMsg = "" Then strMsg = "Out of the office"
	
'--> Connect to Outlook
	Set olkApp = CreateObject("Outlook.Application")
	Set olkSes = olkApp.GetNamespace("MAPI")
	olkSes.Logon olkApp.DefaultProfileName
	
'--> Set the out of office state
	strVer = GetOutlookVersion()
	SetOutOfOfficeState bolSta, strMsg
	
'--> Disconnect from Outlook
	olkSes.Logoff

'--> Clean up objects
	Set olkSes = Nothing
	Set olkApp = Nothing
	
'--> Terminate the script
	WScript.Quit

Sub SetOutOfOfficeState(bolState, strMessage)
    ' Purpose: Set the state of Out of Office.'
    ' Written: 10/12/2009'
    ' Author:  David Lee'
    ' Outlook: 2007'
    Dim olkIS, olkPA, olkSto
    'On Error Resume Next
    If strVer >= "12.0" Then
        For Each olkIS In olkSes.Stores
            If olkIS.ExchangeStoreType = olPrimaryExchangeMailbox Then
            	Set olkSto = olkSes.GetDefaultFolder(olFolderInbox).GetStorage("IPM.Note.Rules.OofTemplate.Microsoft", olIdentifyByMessageClass)
            	olkSto.Body = strMessage
				olkSto.Save
                Set olkPA = olkIS.PropertyAccessor
                olkPA.SetProperty PR_OOF_STATE, bolState
            End If
        Next
    Else
        MsgBox "The SetOutOfOfficeState method is only available to Outlook 2007 and later", vbExclamation + vbOKOnly
    End If
    On Error GoTo 0
    Set olkIS = Nothing
    Set olkPA = Nothing
    Set olkSto = Nothing
End Sub

Function GetOutlookVersion()
    ' Purpose: Returns the Outlook version in the form xx.x.'
    ' Written: 6/3/2011'
    ' Author:  David Lee'
    ' Outlook: All version'
    Dim arrVersion
    arrVersion = Split(olkapp.Version, ".")
    GetOutlookVersion = arrVersion(0) & "." & arrVersion(1)
End Function

Open in new window

0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 40026919
I've requested that this question be deleted for the following reason:

Not enough information to confirm an answer.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 40026920
I object.  There is enough information to confirm an answer.  All that's required is to test the code yourself to see that it works as described.
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

Exchange server is not supported in any cloud-hosted platform (other than Azure with Azure Premium Storage).
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
In this video we show how to create a User Mailbox in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Recipients >> Mailb…
The video tutorial explains the basics of the Exchange server Database Availability groups. The components of this video include: 1. Automatic Failover 2. Failover Clustering 3. Active Manager

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now