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

VB script to update targetAddress from Excel data

I have 650 users who are leaving my Exchange organization. I want to forward email from their old mailbox to their new mailbox by setting the targetAddress attribute on their existing mailbox to forward to their new email address. I have a spreadsheet with two columns - Column A is their existing primary emai address and column B is their new email address.

I need a vb script that will do the following:

1) Read email address from Excel spreadsheet in Column 1.
2) Search Active Directory for user with matching 'mail' attribute.
3) Once user has been found with matching 'mail' attribute, use email address in column A2 to update the'targetAddress' attribute of that same user.

I've attached an example of the .xls file that I have  to work with.
targetAddress.xls
0
sgcarnes
Asked:
sgcarnes
  • 6
  • 5
1 Solution
 
sirbountyCommented:
This should do what you ask...I can't test it completely, so use a test user and give it a try...
I went under the assumption that the data was to be laid out exactly as in your attachment.
The ExcelFile variable should point to the path\filename where the excel sheet is located and the sheet name should be, as in your example, named IHS_to_be_migrated.

Good luck!
Const ADS_PROPERTY_APPEND = 3
Const ADS_SCOPE_SUBTREE = 2
 
Dim objRoot : Set objRoot = GetObject("LDAP://RootDSE")
Dim objDomain : Set objDomain = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))
Dim dicData : Set dicData = CreateObject("Scripting.Dictionary")
 
Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
Dim objCommand : Set objCommand =   CreateObject("ADODB.Command")
Dim objRS : Set objRS = CreateObject("ADODB.Recordset")
 
ExcelFile = "C:\targetAddress.xls"
 
With objConnection
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  .ConnectionString="Data Source=" & ExcelFile & ";Extended Properties=""Excel 8.0;HDR=No;"";"
  .Open
End With
 
strSQL = "SELECT * FROM [IHS_to_be_migrated$]"
 
objRS.Open strSQL, objConnection
 
objRS.MoveFirst
 
Do While Not objRS.EOF
  If IsNull(objRS.Fields(0)) Then Exit Do
    MailAddress = objRS.Fields(0).Value
    TargetAddress = objRS.Fields(1).Value
    dicData.Add MailAddress, TargetAddress
    objRS.MoveNext
Loop
 
objRS.Close
objConnection.Close
 
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
For Each item in dicData.Keys
  objCommand.CommandText = "SELECT aDSPath FROM '" & objDomain.aDSPath & "' WHERE mail='" & item & "'"
  Set objRS = objCommand.Execute
  objRS.MoveFirst
  Do Until objRS.EOF
    Dim objUser : Set objUser = GetObject(objRS.Fields(0))
    objUser.PutEx ADS_PROPERTY_APPEND, "targetAddress", Array(dicData(item))
    objRS.MoveNext  
  Loop
Next
 
Set objRS = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Set dicData = Nothing
Set objDomain = Nothing
Set objRoot = Nothing

Open in new window

0
 
sgcarnesAuthor Commented:
I think this is exactly what I want but I need to run it against multiple target domains. Can you add a couple of constants that I could modify to change the target domain? I'm just not sure of the syntax.
1
 
sirbountyCommented:
Sure...just alter the third line to read a similar path for your domain...
Const ADS_PROPERTY_APPEND = 3
Const ADS_SCOPE_SUBTREE = 2
strPath = "dc=domain,dc=com"
 
Dim dicData : Set dicData = CreateObject("Scripting.Dictionary")
 
Dim objConnection : Set objConnection = CreateObject("ADODB.Connection")
Dim objCommand : Set objCommand =   CreateObject("ADODB.Command")
Dim objRS : Set objRS = CreateObject("ADODB.Recordset")
 
ExcelFile = "C:\targetAddress.xls"
 
With objConnection
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  .ConnectionString="Data Source=" & ExcelFile & ";Extended Properties=""Excel 8.0;HDR=No;"";"
  .Open
End With
 
strSQL = "SELECT * FROM [IHS_to_be_migrated$]"
 
objRS.Open strSQL, objConnection
 
objRS.MoveFirst
 
Do While Not objRS.EOF
  If IsNull(objRS.Fields(0)) Then Exit Do
    MailAddress = objRS.Fields(0).Value
    TargetAddress = objRS.Fields(1).Value
    dicData.Add MailAddress, TargetAddress
    objRS.MoveNext
Loop
 
objRS.Close
objConnection.Close
 
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
 
For Each item in dicData.Keys
  objCommand.CommandText = "SELECT aDSPath FROM 'LDAP://" & strPath & "' WHERE mail='" & item & "'"
  Set objRS = objCommand.Execute
  objRS.MoveFirst
  Do Until objRS.EOF
    Dim objUser : Set objUser = GetObject(objRS.Fields(0))
    objUser.PutEx ADS_PROPERTY_APPEND, "targetAddress", Array(dicData(item))
    objRS.MoveNext  
  Loop
Next
 
Set objRS = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Set dicData = Nothing

Open in new window

0
Improve Your Query Performance Tuning

In this FREE six-day email course, you'll learn from Janis Griffin, Database Performance Evangelist. She'll teach 12 steps that you can use to optimize your queries as much as possible and see measurable results in your work. Get started today!

 
sgcarnesAuthor Commented:
I get script error Line45 Char3
One or more errors occurred during processing of command.
Code 80040E14
0
 
sirbountyCommented:
Can you post what you used for strPath? (mask any company/domain names as needed).
0
 
sgcarnesAuthor Commented:
strPath = "dc=abc,dc=xyz,dc=com"
0
 
sirbountyCommented:
and abc is a child domain of xyz?
0
 
sgcarnesAuthor Commented:
Correct.
0
 
sirbountyCommented:
Modify this portion of the code:

For Each item in dicData.Keys
  objCommand.CommandText = "SELECT aDSPath FROM 'LDAP://" & strPath & "' WHERE mail='" & item & "'"

to read:
For Each item in dicData.Keys
  objCommand.CommandText = "SELECT aDSPath FROM 'LDAP://" & strPath & "' WHERE mail='" & item & "'"
wscript.echo objCommand.CommandText
 
'please post the output - mask any domain names that you need to...

Open in new window

0
 
sgcarnesAuthor Commented:
Specifying the strPath as "domain_controller/dc=abc,dc=xyz,dc=com" seems to do the trick.
0
 
sirbountyCommented:
Happy to help - thanx for the grade! :^)
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Improve Your Query Performance Tuning

In this FREE six-day email course, you'll learn from Janis Griffin, Database Performance Evangelist. She'll teach 12 steps that you can use to optimize your queries as much as possible and see measurable results in your work. Get started today!

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