Creating secondary proxy addresses

Often times it may become necessary to stamp an additional SMTP address (proxy address) on a user account, either as part of a migration, or organizational domain name change etc...  

Here's a VBScript example of how to add a new SMTP domain name to each user account in AD, preserving the user's name (everything to the left of the @ in the address), and leaving the Primary SMTP (Reply-To) address the same.

Just change the highlighted text in the strQuery line to reflect your domain.  If you want to restrict the focus to a specific OU you can add OU=xxxx before the DC=.

You'll also want to replace the text in the second highlighted line to reflect your new smtp domain that you want to add to each user.


On Error Resume next

Function FindUser

Set oConnection = CreateObject("ADODB.Connection")
Set oCMD = CreateObject("ADODB.Command")

oConnection.Provider = "AdsDSOObject"
oConnection.Properties("ADSI Flag") = 1
oConnection.Open "Active Directory Provider"

Set oCMD.ActiveConnection = oConnection

oCMD.Properties("Page Size") = 20000
oCMD.Properties("Searchscope") = 2"sort on") = "msExchHomeServerName"
strQuery = "<LDAP://DC=contoso,DC=com>;(&(homemdb=*));proxyAddresses,distinguishedName,cn;subtree"
oCMD.CommandText = strQuery
set oRecordSet = oCMD.Execute
wscript.echo oRecordSet.recordcount

While Not oRecordSet.EOF
  strContactCN = oRecordSet.Fields("cn").Value
  strContactDN = oRecordSet.Fields("distinguishedName").Value
  Set objUser = GetObject("LDAP://" & strContactDN)
  arrProxyAddresses = objUser.GetEx("proxyAddresses")
  For Each strProxyAddress In arrProxyAddresses
    If InStr(strProxyAddress,"SMTP") <> 0 Then
      strNewProxyAddress = "smtp:" & strNewName & ""
      objUser.PutEx 3, "proxyAddresses", Array(strNewProxyAddress)
    End If
End Function


Comments (1)

  1. dkegg says:

    I haven't used this script in over 2 years, then suddenly twice in the same week!

    Then, I discovered today that in the very rare case where the DistinguishedName field might contain a forward slash (ie. a notes migration), you will receive the error :

    (null) 0x80005000

    This can be remedied by adding the following line before the  Set objUser = GetObject("LDAP://" & strContactDN)  :

    strContactDN = Replace(strContactDN, "/", "/")

    This will use the backslash escape character so VBScript doesn't get angry…

Skip to main content