• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 601
  • Last Modified:

VB script to modify Exchange delivery options on specific account

Environment:
Windows Server 2003, 2003 native AD, Exchange 2003 SP2

Issue:
At the end of each workday our IT team manually changes the 'Delivery Options' (under 'Exchange General' tab) of our general IT Support AD account to forward to an after-hours email address.  Then first thing in the morning someone has to manually go in and forward it back to a different email address.  The problem is that can occur and important after-hours emails are getting missed.  

Requirement:
We need a way to automate this task (i.e. with VB Script or other script) and run it as a scheduled task.

Unfortunately we don't have in-house scripting experts.  Does anyone out there know how this can be accomplished?

Any help would be appreciated.

Thanks.
0
BNPIT
Asked:
BNPIT
  • 5
  • 4
1 Solution
 
prashanthdCommented:
Try the following vbscript.

run following from command  cscript filename.vbs

regards
Prashanth


mailboxtomodify = souce@xxxxxxxxxx 'IT Support email address
addresstoforwardto = target@xxxxxxxxxx 'Emailaddress to forward to

Set objmailbox = GetObject("LDAP://"; & getuserdn(mailboxtomodify))
WScript.echo "Forwarding Recipient currently set to : " &
objmailbox.altRecipient
objmailbox.altRecipient = getuserdn(addresstoforwardto)
WScript.echo "Forwarding Recipient changed to : " & objmailbox.altRecipient
objmailbox.deliverAndRedirect = True
objmailbox.setinfo


Function getuserdn(emailaddress)
    
    Set conn = CreateObject("ADODB.Connection")
    Set com = CreateObject("ADODB.Command")
    Set iAdRootDSE = GetObject("LDAP://RootDSE";)
    strNameingContext = iAdRootDSE.Get("defaultNamingContext")
    Conn.Provider = "ADsDSOObject"
    Conn.Open "ADs Provider"
    mbQuery = "<LDAP://"; & strNameingContext & ">;(&(objectclass=user)(mail=" &
    emailaddress & "));name,distinguishedName;subtree"
    Com.ActiveConnection = Conn
    Com.CommandText = mbQuery
    Set Rs = Com.Execute
    While Not Rs.EOF
        Userdn = rs.fields("distinguishedName")
        rs.movenext
    Wend
    getuserdn = userdn
    
End Function

Open in new window

0
 
BNPITAuthor Commented:
Thanks for the quick reply.  I'm getting errors with the script though.

All I modified were the first 2 lines as follows:

mailboxtomodify = itsupport 'IT Support email address
addresstoforwardto = itsupport2 'Emailaddress to forward to

When I ran the script from command prompt (I also tried manually running the vbs file by double-clicking) I got the attached error message.

 command prompt error windows script host error
0
 
prashanthdCommented:
Please give in double quotes

and give the emailaddress

mailboxtomodify = "itsupport@xxx.com" 'IT Support email address
addresstoforwardto = "itsupport2@xxx.com": 'Emailaddress to forward to
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
BNPITAuthor Commented:
I used double quotes around the email addresses but I still get the error on line 4, char 37.
0
 
prashanthdCommented:
Try the folllowing

regards
Prashanth
On Error Resume Next
mailboxtomodify = "" 'IT Support email address
addresstoforwardto = "" 'Emailaddress to forward to

Set objmailbox = GetObject("LDAP://" & getuserdn(mailboxtomodify))
WScript.echo "Forwarding Recipient currently set to : " & objmailbox.altRecipient
objmailbox.altRecipient = getuserdn(addresstoforwardto)
WScript.echo "Forwarding Recipient changed to : " & objmailbox.altRecipient
objmailbox.deliverAndRedirect = True
objmailbox.setinfo

Function getuserdn(emailaddress)
    
    Set conn = CreateObject("ADODB.Connection")
    Set com = CreateObject("ADODB.Command")
    Set iAdRootDSE = GetObject("LDAP://RootDSE")
    strNameingContext = iAdRootDSE.Get("defaultNamingContext")
    Conn.Provider = "ADsDSOObject"
    Conn.Open "ADs Provider"
    mbQuery = "<LDAP://" & strNameingContext & ">;(&(objectclass=user)(mail=" & emailaddress & "));name,distinguishedName;subtree"
    Com.ActiveConnection = Conn
    Com.CommandText = mbQuery
    Set Rs = Com.Execute
    While Not Rs.EOF
        Userdn = rs.fields("distinguishedName")
        WScript.echo userdn
        rs.movenext
    Wend
    getuserdn = userdn
    
End Function

Open in new window

0
 
BNPITAuthor Commented:
Well, I didn't get any errors this time but it didn't change the AD property as expected.  I ran it from a DC, from my Exchange Server, and from a workstation and it never made the change.  Any ideas?
0
 
BNPITAuthor Commented:
Also, it shouldn't be a permissions issue because I have God access to my environment.
0
 
prashanthdCommented:
Can you try commenting the on error resume next and run the script.

Secondly is it displaying any user DN's to screen?
0
 
BNPITAuthor Commented:
This didn't work for us.  The script just threw errors and we gave up after several attempts to modify.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now