Batch change of domain names in e-mail addresses
Sometimes you need to change domain names in contacts in Outlook because the employees move to a different company or company migrates to a different e-mail provider. Searching and editing all addresses manually (e.g. from receipient@abc.com to receipient@new_name.com) may be tiresome. If we fail to modify the addresses our mail will stop delivering once forwarding service from the old to new domain expires.
The procedure that follows opens two windows: the first one is where you put a domain name after the "@" symbol (the domain you want to change), and the second window is where you put the new domain name (Fig. 1).
http://outlook-center.com/article/upload/191.jpg http://outlook-center.com/article/upload/183.jpg
Fig. 1. Two windows displayed during the procedure.
Sub domain_change()
Dim oContact As ContactItem
Dim oContactFolder As MAPIFolder
Dim x&, item As Object, msg$, Old_domain$, New_domain$, Message$
Message = "Provide the domain name to change." & vbCr & vbCr _
& "A domain is a name after the @ symbol in the e-mail address."
Old_domain = InputBox(Message, "Changing domain names in e-mail addresses. Step 1/2")
Message = "Provide a new domain name that will be replaced with: " & Old_domain & vbCr & vbCr _
& "A domain is a name after the @ symbol in the e-mail address."
New_domain = InputBox(Message, "Changing domain names in e-mail addresses. Step 2/2")
If Len(Old_domain) = 0 Or Len(New_domain) = 0 Then GoTo finish
On Error GoTo errors
'the procedure applies to the default list of folders
oContactFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
For x = 1 To oContactFolder.Items.Count
If oContactFolder.Items(x).Class <> 40 Then GoTo nextstep
oContact = oContactFolder.Items(x)
DoEvents()
If Not oContact Is Nothing Then
With oContact
If .Email1Address Like "*" & Trim(Old_domain) & "*" Or _
.Email1Address Like "*" & Trim(Old_domain) Then
.Email1Address = Split(.Email1Address, "@")(0) & "@" & Trim(New_domain)
msg = msg & .FullName & " -> address changed from: " & .Email1Address & " -> to: " & _
Split(.Email1Address, "@")(0) & "@" & Trim(New_domain) & vbCr
.Save()
End If
End With
End If
nextstep:
Next
If Len(msg) = 0 Then
MsgBox("No address meets the condition" & vbCr _
& Old_domain & " -> " & New_domain, vbInformation, "Procedure ''Domain change''")
Else
MsgBox(msg, vbInformation, "Procedure ''Domain change''")
End If
oContact = Nothing
oContactFolder = Nothing
Exit Sub
finish:
MsgBox("No values were provided for the procedure" & vbCr _
& "Changing domain namaes has been canceled", vbExclamation, " Error warning")
Exit Sub
errors:
MsgBox("Procedure's error: ''domain_change''" & vbCr _
& Err.Number & vbCr _
& Err.Description, vbExclamation, " Error warning")
End Sub
To learn how to mount the "domain_change" procedure onto a button on the MS Outlook menu, read this article.
This macro is responsible for:
• checking if both the old and new domain are provided
• searching the default contact folder for the old domain
• changing the domain and saving the contact item, without any other modifications in the contact item
• displaying the results on finishing.
This macro does not change the names in distribution lists (only contacts items).
You can develop this application by building an interface in VBA. For example, you can add text boxes and assign variables to them from the InputBox command in the above procedure, and delete the lines with warnings.
(c) Shon Oskar
© All rights reserved. No part or whole of this article may not be reproduced or published without prior permission.
Oryginal article publicate at this page