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 newproxyaddr.com 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
oCMD.properties("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
      arrName=Split(strProxyAddress,"@")
      strName=arrName(0)
      valRight=Len(strName)-5
      strNewName=Right(strName,valRight)
      strNewProxyAddress = "smtp:" & strNewName & "@newproxyaddr.com"
      objUser.PutEx 3, "proxyAddresses", Array(strNewProxyAddress)
      objUser.SetInfo
    End If
  Next
   oRecordSet.MoveNext
  Wend
End Function

FindUser

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