The Moose and Squirrel Files

October 7, 2008

HTA to Set Exchange “Out of Office” Message

Filed under: Code — Tags: , , , , — networknerd @ 8:18 pm

This HTA was created to help streamline a common helpdesk task, setting the OOF message for users who have gone on holidays and failed to set the OOF message.

The original process involved the helpdesk giving themselves access to the mailbox in question, creating an outlook profile for the users mailbox,  and  starting outlook to set the OOF message, and finally revoking the permissions to the users mailbox. After performing an audit of mailbox permissions it became obvious that the final step of revoking permissions was being frequently overlooked.

The script consists of a few simple steps

  1. Perform an AD search for the users samaccountname and return their exchange server.
  2. Grant full control to the mailbox for the helpdesk staff member.
  3. Create a mapi profile for the mailbox.
  4. Get/Set the current OOFmessage.
  5. Toggle the Out of Office status flag.

The process of managing the removal of mailbox permissions is handled in the window unload function of the browser.

Listing 1 – OOF.HTA

<html>
<head>
<title>Set out of Office Message</title>
<HTA:APPLICATION
ID="OOF"
APPLICATIONNAME="Set Out Of Office Message"
SCROLL="yes"
SINGLEINSTANCE="yes"
>
</head>
<SCRIPT LANGUAGE="VBScript"> option explicit
Rem reference http://www.cdolive.com/outofofficecalendar.htm Rem Updated to grant and remove permissions to the mailbox automatically CONST ADS_ACEFLAG_INHERIT_ACE = 2 CONST ADS_RIGHT_DS_CREATE_CHILD = 1 CONST ADS_ACETYPE_ACCESS_ALLOWED = 0 Const ACE_MB_FULL_ACCESS = &h1 Rem Define all our variables Dim strProfileInfo, CDOSession, strOOFText, objButton, objInfostore,CdoFolderRoot Dim objConnection, objCommand, objRecordSet, intRetcode, objOption Dim strExchsvr, strPath, objUser, objTrustee, strTrustee, WshNetwork,boolRightsSet, objshell Dim objMBXlist, oSecurityDescriptor, dacl, ace, arrTemp '***************************************************************************** '* function window_onload '* Purpose: Initialise all the global variables required to proceed or '* terminate the application. '* Inputs: none '* Returns: nothing '***************************************************************************** sub window_onload on error resume next set objMBXlist = createobject("scripting.dictionary") if err.number = 0 then on error goto 0 strTrustee = getTrusteeName() else msgbox "Fatal Error - Could not create dictionary object." & vbcrlf & "Application will now close.", VBCRITICAL self.close() end if if strTrustee = "" then msgbox "Fatal Error - Could not get logged on user info." & vbcrlf & "Application will now close.", VBCRITICAL self.close() end if inorout.checked = False end sub '***************************************************************************** '* function window_onunload '* Purpose: ensure the removal of access rights from all accessed mailboxes '* terminate the application. '* Inputs: none '* Returns: nothing '***************************************************************************** sub window_onunload for each strPath in objMBXlist.keys removeMbxRights strpath,objMBXlist.item(strPath) next end sub '***************************************************************************** '* function getTrusteeName '* Purpose: get the username and domain for the helpdesk staff to be added to '* the access control list on the users '* Inputs: none '* Returns: String in the format domain\username '***************************************************************************** function getTrusteeName on error resume next Set WshNetwork = CreateObject("WScript.Network") if err.number = 0 then getTrusteeName = WshNetwork.UserDomain & "\" & WshNetwork.UserName else getTrusteeName = "" err.clear end if on error goto 0 end function '***************************************************************************** '* function get_OOF_TEXT '* Purpose: get the users current "Out of Office" Message into a text box '* Inputs: none '* Returns: nothing '***************************************************************************** sub get_OOF_TEXT disablecontrols(True) strProfileInfo = strExchsvr & vbLf & staffcode.value Set CDOSession = CreateObject("MAPI.SESSION") on error resume next CDOSession.Logon "", "", False, True, 0, False, strProfileInfo if err.number = 0 then OOF_TEXT.value = CDOSession.OutOfOfficeText if CDOSession.OutOfOffice = True then inorout.checked = True else inorout.checked = False end if inorout.disabled = "false" CDOSession.Logoff else msgbox "Error logging on to mailbox." & vbcrlf & err.number & vbcrlf _ & err.description & vbcrlf & _ "Wait a few minutes for AD permissions to replicate and try again!", VBCRITICAL end if on error goto 0 Set CDOSession = Nothing disablecontrols(False) end sub '***************************************************************************** '* function set_OOF_TEXT '* Purpose: set the users current "Out of Office" Message from text box value '* Inputs: none '* Returns: nothing '***************************************************************************** sub set_OOF_TEXT disablecontrols(False) strProfileInfo = strExchsvr & vbLf & staffcode.value Set CDOSession = CreateObject("MAPI.SESSION") on error resume next CDOSession.Logon "", "", False, True, 0, False, strProfileInfo if err.number = 0 then CDOSession.OutOfOfficeText = OOF_TEXT.value CDOSession.OutOfOffice = True inorout.checked = True inorout.disabled = "false" CDOSession.Logoff else msgbox "Error logging on to mailbox." & vbcrlf & err.number & vbcrlf _ & err.description & vbcrlf & _ "Wait a few minutes for AD permissions to replicate and try again!", VBCRITICAL end if on error goto 0 Set CDOSession = Nothing disablecontrols(False) end sub '***************************************************************************** '* function finduser '* Purpose: perform active directory query '* Inputs: none '* Returns: nothing '***************************************************************************** sub finduser() Set objConnection = CreateObject("ADODB.Connection") objConnection.Open "Provider=ADsDSOObject;" Set objCommand = CreateObject("ADODB.Command") objCommand.ActiveConnection = objConnection ' search for the users staffcode from accounts that aren't disabled objCommand.CommandText = _ "<GC://dc=acme,dc=com,dc=au>;" & _ "(&(&(objectClass=user)(objectCategory=person))(&(samaccountname=" & staffcode.value & _ ")(!userAccountControl:1.2.840.113556.1.4.803:=2)));" & _ "name,adspath,msExchHomeServerName;subtree" Set objRecordSet = objCommand.Execute if objRecordSet.recordcount > 1 then intRetcode = msgbox("Error - More than one active account with staffcode " & _ staffcode.value & " found!" & vbcrlf & "List ldap path of accounts?",VBCRITICAL+VBYESNO) if intRetcode = VBYES then do While Not objRecordset.EOF Set objOption = Document.createElement("OPTION") objOption.Text = objRecordset.Fields("adspath") objOption.Value = objRecordset.Fields("adspath") SearchResults.Add(objOption) objRecordset.MoveNext loop SearchResults.style.visibility ="Visible" else SearchResults.style.visibility ="Hidden" end if exit sub end if if objRecordSet.recordcount = 0 then msgbox "Failed to find staffcode in active directory" & VBCRLF & "Check the staffcode is correct", VBCRITICAL exit sub end if intRetcode = msgbox("StaffCode " & staffcode.value & " found!" & vbcrlf & _ "Grant full control to mailbox for " & strTrustee,VBINFORMATION+VBYESNO) if intRetcode = VBNO then setbutton.disabled = "True" getbutton.disabled = "True" inorout.disabled = "True" inorout.checked = False exit sub end if do While Not objRecordset.EOF strExchsvr = objRecordset.Fields("msExchHomeServerName") arrTemp = split(strExchsvr, "=") strExchsvr = arrtemp(ubound(arrtemp)) strPath = replace(objRecordset.Fields("adspath"),"GC://", "LDAP://") objRecordset.MoveNext loop objConnection.Close if setMbxRights(strPath, strTrustee) = True then setbutton.disabled = "false" getbutton.disabled = "false" end if end sub '***************************************************************************** '* function disablecontrols '* Purpose: activate/de-activate controls as appropriate to application state '* Inputs: none '* Returns: nothing '***************************************************************************** sub disablecontrols(booldisable) progress.style.visibility = "Visible" if booldisable = True then setbutton.disabled = "True" getbutton.disabled = "True" inorout.disabled = "True" else progress.style.visibility = "hidden" setbutton.disabled = "False" getbutton.disabled = "False" inorout.disabled = "False" end if end sub '***************************************************************************** '* function setMbxRights '* Purpose: add trustee to the users mailbox with full control '* Inputs: string - the adspath of the users mailbox '* string - the trustee's domain & username, formatted domain\username '* Returns: boolean, true if succesful '***************************************************************************** function setMbxRights(adspath,strTrustee) setMbxRights = False if not objMBXlist.exists(adspath) then objMBXlist.add adspath,strTrustee set objUser = GetObject(adspath) on error resume next Set oSecurityDescriptor = objUser.MailboxRights if err.number <> 0 then if err.number = 438 then msgbox "This application must be run on a workstation with" & vbcrlf _ & "the exchange management tools installed!", vbcritical err.clear exit function else msgbox "Error getting mailbox security Descriptor." & vbcrlf _ & err.description & vbcrlf and err.number, vbcritical exit function end if end if on error goto 0 Set dacl = oSecurityDescriptor.DiscretionaryAcl AddAce dacl, strTrustee, ADS_RIGHT_DS_CREATE_CHILD, _ ADS_ACETYPE_ACCESS_ALLOWED, ADS_ACEFLAG_INHERIT_ACE, 0, 0, 0 oSecurityDescriptor.DiscretionaryAcl = dacl ' Save new SD onto the user. objUser.MailboxRights = oSecurityDescriptor ' Commit changes from the property cache to the information store. objUser.SetInfo setMbxRights = True end function '***************************************************************************** '* function removeMbxRights '* Purpose: remove trustee from all mailboxes to which it was added '* Inputs: string - the adspath of the users mailbox '* string - the trustee's domain & username, formatted domain\username '* Returns: boolean, true if succesful '***************************************************************************** sub removeMbxRights(adspath,strTrustee) set objUser = GetObject(adspath) Set oSecurityDescriptor = objUser.MailboxRights Set dacl = oSecurityDescriptor.DiscretionaryAcl For Each ace In Dacl If (LCase(ace.trustee) = LCase(strTrustee)) and _ ((ace.AccessMask AND ACE_MB_FULL_ACCESS)=ACE_MB_FULL_ACCESS) Then Dacl.RemoveAce ace MsgBox "Mailbox rights have been removed", VBINFORMATION End If Next oSecurityDescriptor.DiscretionaryAcl = dacl ' Save new SD onto the user. objUser.MailboxRights = oSecurityDescriptor ' Commit changes from the property cache to the information store. objUser.SetInfo end sub '******************************************************************** '* Code shamelessly copied from Microsoft KB310866 '* http://support.microsoft.com/kb/310866 '* Function AddAce(dacl, TrusteeName, gAccessMask, gAceType, '* gAceFlags, gFlags, gObjectType, gInheritedObjectType) '* '* Purpose: Adds an ACE to a DACL '* Input: dacl Object's Discretionary Access Control List '* TrusteeName SID or Name of the trustee user account '* gAccessMask Access Permissions '* gAceType ACE Types '* gAceFlags Inherit ACEs from the owner of the ACL '* gFlags ACE has an object type or inherited object type '* gObjectType Used for Extended Rights '* gInheritedObjectType '* '* Output: Object - New DACL with the ACE added '* '******************************************************************** Function AddAce(dacl, TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType) Dim Ace1 ' Create a new ACE object. Set Ace1 = CreateObject("AccessControlEntry") Ace1.AccessMask = gAccessMask Ace1.AceType = gAceType Ace1.AceFlags = gAceFlags Ace1.Flags = gFlags Ace1.Trustee = TrusteeName 'See whether ObjectType must be set If CStr(gObjectType) <> "0" Then Ace1.ObjectType = gObjectType End If 'See whether InheritedObjectType must be set. If CStr(gInheritedObjectType) <> "0" Then Ace1.InheritedObjectType = gInheritedObjectType End If dacl.AddAce Ace1 ' Destroy objects. Set Ace1 = Nothing End Function '***************************************************************************** '* function setINOUT '* Purpose: set the users OOF flag to activate/de-activate OOF processing '* Inputs: none '* Returns: nothing '***************************************************************************** sub setINOUT disablecontrols(True) strProfileInfo = strExchsvr & vbLf & staffcode.value Set CDOSession = CreateObject("MAPI.SESSION") on error resume next CDOSession.Logon "", "", False, True, 0, False, strProfileInfo if err.number = 0 then if inorout.checked = True then CDOSession.OutOfOffice = True else CDOSession.OutOfOffice = False end if CDOSession.Logoff else msgbox "Error logging on to mailbox." & vbcrlf & err.number & vbcrlf _ & err.description, VBCRITICAL end if on error goto 0 Set CDOSession = Nothing disablecontrols(False) end sub </SCRIPT> <body> <B>Step 1. Enter the user's staff code</B><P> <input type="text" name="staffcode" size="30"> <input id=srchbutton class="button" type="button" value="Search for User" name="set_text_button" onClick="finduser"> <select size="5" name="SearchResults" style="Visibility:hidden"> </select> <P><P> <B>Step 2. Retrieve/Set the users Out of Office message</B><p><p> <textarea name="OOF_TEXT" rows=5 cols=70></textarea><p> <input disabled id=getbutton class="button" type="button" value="Get Message" name="get_text_button" onClick="get_OOF_TEXT"> <input disabled id=setbutton class="button" type="button" value="Set Message" name="set_text_button" onClick="set_OOF_TEXT"> <input disabled id=inorout type="checkbox" name="InorOUT" value="IN" checked="False" onClick="setINOUT"> I am currently out of the office <P> <span id="Progress" style="visibility:Hidden"> Operation in progress - please wait&nbsp;&nbsp;&nbsp;&nbsp;<img src="loading.gif" border="0" width="165" height="15"> </span> <p><p><B>Step 3. Send a test email</B><p><p> </body></html>

Create a free website or blog at WordPress.com.