My company changed its name a couple weeks ago and so I needed to add a new primary address for those who had the old domain as a primary, and move the old primary to a secondary. I was surprised that I couldn’t hardly find any existing scripts to accommodate such an endeavor so I had to resort to doing it myself.
This script goes through all accounts in a given AD domain and whose primary email address is the "old" SMTP domain name, makes the primary a secondary, takes the username portion of the address and appends the new domain and makes it the new primary. I log all of the old address and new addresses to the screen, so redirect the output to a file to capture that. It doesn’t check for preexisting addresses so conflicts can occur. I had previously done my own extract to look for those, so dealing with them manually was easier and faster than coding for that.
I modified the script each time I ran it to change the AD domain I wanted to search (though I could have just defined an array of domain names and looped through each of them), and ran it against DLs and public folders, too, adjusting the filter to return the different object types. You will need to do the same.
Download the code here, or copy below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
Option Explicit 'Set value for domain to run against and LDAP filter to use 'Also set the old and new SMTP domain names on line 33 'If you need to update the display name to remove a company designation, that is line 80 dim strDomain, strSearchFilter strdomain = "nbdomain" 'Put the NetBIOS domain name here 'Update filter below to return the object types you want, e.g., users, groups, publicfolders strSearchFilter = "(&(objectcategory=publicfolder)(mailnickname=*)(mail=*@olddomain.com))" 'Connect to AD Dim objConnection, objCommand, objRecordSet, objUser Set objConnection = CreateObject("ADODB.Connection") objConnection.Open "Provider=ADsDSOObject;" Set objCommand = CreateObject("ADODB.Command") objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 10000 'Retrieve user objects Const ADS_PROPERTY_UPDATE = 2 objCommand.CommandText = "<LDAP://" & strDomain & ">; " & strSearchFilter & "; distinguishedname" Set objRecordSet = objCommand.Execute wscript.echo "Count:" & objRecordSet.RecordCount While not objRecordSet.EOF Set objUser = GetObject("LDAP://" & Replace(objRecordSet.Fields("distinguishedname"),"/", "\/")) wscript.echo objUser.displayName & "; " & strDomain & "\" & objUser.sAMAccountName 'Set values for new email addresses Dim blnExists, strNewMail, i, strOldProxy, strAddress Dim arrProxyAddresses, intProxyAddresses, strNewProxy, intProxyForLoop arrProxyAddresses = objUser.proxyAddresses intProxyAddresses = UBound(arrProxyAddresses) intProxyForLoop = intProxyAddresses 'Set value for mail strNewMail = Replace(objUser.mail, "@olddomain.com", "@newdomain.com") wscript.echo vbTab & "Old mail: " & objUser.mail wscript.echo vbTab & "New mail: " & strNewMail wscript.echo "" 'Log old SMTP proxies For each strOldProxy in arrProxyAddresses If UCase(Left(strOldProxy,5)) = "SMTP:" Then wscript.echo vbTab & "Old proxies: " & strOldProxy End If Next 'Change primary to secondary and add new primary blnExists = False For i = 0 to intProxyForLoop dim strAddressType, strAddressBody strAddressType = Left(arrProxyAddresses(i),5) strAddressBody = Mid(arrProxyAddresses(i),6) If UCase(strAddressType) = "SMTP:" Then If strAddressType = "SMTP:" Then arrProxyAddresses(i) = Replace(arrProxyAddresses(i), "SMTP:", "smtp:") Else If LCase(strAddressBody) = LCase(strNewMail) Then blnExists = True arrProxyAddresses(i) = Replace(arrProxyAddresses(i), "smtp:", "SMTP:") End If End If End If If i = intProxyForLoop Then If Not blnExists Then ReDim Preserve arrProxyAddresses(intProxyAddresses + 1) arrProxyAddresses(intProxyAddresses + 1) = "SMTP:" & strNewMail End If End If Next 'Log new SMTP proxies For each strNewProxy in arrProxyAddresses If UCase(Left(strNewProxy,5)) = "SMTP:" Then wscript.echo vbTab & "New proxies: " & strNewProxy End If Next wscript.echo "" 'Remove component designation from display name Dim strDisplayName strDisplayName = Replace(objUser.displayName, " - COMPANY", "") wscript.echo vbTab & "New display: " & strDisplayName 'Commit changes objUser.Put "mail", strNewMail objUser.PutEx ADS_PROPERTY_UPDATE, "proxyAddresses", arrProxyAddresses objUser.Put "displayName", strDisplayName On Error Resume Next objUser.SetInfo If Err.Number <> 0 Then wscript.echo "Update unsuccessful!" Else wscript.echo "Update successful" End If wscript.echo vbCRLF On Error Goto 0 objRecordSet.MoveNext Wend Set objRecordSet = Nothing Set objUser = Nothing Set objCommand = Nothing Set objConnection = Nothing |