Scripted forwarding for Outlook 2003
- by John Gardeniers
We have a staff member in sales who has gone onto a 4 day week (getting ready for retirement), so each Thursday afternoon her email needs to be forwarded to another user and each Friday afternoon it needs to be set back.
I'm using the VBS script below to do this, run via the Task Scheduler. Although the script appears to do it's job, based on what I see when I view the user's Exchange settings, Exchange doesn't always recognise that the setting has changed. e.g. Last Thursday the forwarding was a enabled and worked correctly. On Friday the script did it's thing to clear the forwarding but Exchange continued to forward messages all weekend.
I found that I can force Exchange to honour the changed setting be merely opening and closing the user's properties in ADUC. Of course I don't want to have to do that. Is there a non-manual way I can have Exchange read and honour the setting?
The script (VBS):
' Call this script with the following parameters:
'
' SrcUser - The logon ID of the suer who's account is to be modified
' DstUser - The logon account of the person to who mail is to be forwarded
' Use "reset" to clear the email forwarding
SrcUser = WScript.Arguments.Item(0)
DstUser = WScript.Arguments.Item(1)
SourceUser = SearchDistinguishedName(SrcUser) 'The user login name
Set objUser = GetObject("LDAP://" & SourceUser)
If DstUser = "reset" then
objUser.PutEx 1, "altRecipient", ""
Else
ForwardTo = SearchDistinguishedName(DstUser)' The contact common name
objUser.Put "AltRecipient", ForwardTo
End If
objUser.SetInfo
Public Function SearchDistinguishedName(ByVal vSAN)
Dim oRootDSE, oConnection, oCommand, oRecordSet
Set oRootDSE = GetObject("LDAP://rootDSE")
Set oConnection = CreateObject("ADODB.Connection")
oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection
oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & ">;(&(objectCategory=User)(samAccountName=" & vSAN & "));distinguishedName;subtree"
Set oRecordSet = oCommand.Execute
On Error Resume Next
SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
On Error GoTo 0
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing
Set oRootDSE = Nothing
End Function
