Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNameSpace("MAPI")
Set objContactsFolder = myNameSpace.GetDefaultFolder(10)
'objContactsFolder.Display
Set objContacts = objContactsFolder.Items

'Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Set objContacts = objContactsFolder.Items

Sub ChangeEmail(strold, strnew, icount)
   strold = lcase(strold) & "@abac.edu"
   strnew = lcase(strnew) & "@abac.edu"
   For Each objContact In objContacts
      If TypeName(objContact) = "ContactItem" Then
	    objContact.Email1Address = lcase(objContact.Email1Address)
            If objContact.Email1Address = strold Then
               objContact.Email1Address = strnew
               objContact.Save
               iCount = iCount + 1
            End If
	    objContact.Email2Address = lcase(objContact.Email2Address)
            If objContact.Email2Address = strold Then
               objContact.Email2Address = strnew
               objContact.Save
               iCount = iCount + 1
            End If
            objContact.Email3Address = lcase(objContact.Email3Address)
            If objContact.Email2Address = strold Then
               objContact.Email3Address = strnew
               objContact.Save
               iCount = iCount + 1
            End If
      End If
   Next
End Sub



   ' Specify which contact folder to work with
'   Set objContactsFolder = Session.GetDefaultFolder(olFolderContacts)
   Set objContacts = objContactsFolder.Items

   MsgBox ("Changing e-mail addresses from long to short will take quite a while. For example, afitz to afitzgerald")
   MsgBox ("When prompted for allowing access to Outlook, respond with 10 minutes, Allow, Yes.")
   
   iCount = 0
   
   respond = MsgBox("Begin Updating e-mail addresses?", vbOKCancel)
   If respond = 2 Then
      MsgBox "Exiting without updating contacts."
   Else
	ChangeEmail "mandersn", "manderson", icount
	ChangeEmail "bapwhite", "bapplewhite", icount
	ChangeEmail "cbierbau", "cbierbaum", icount
	ChangeEmail "bullngtn", "ebullington", icount
	ChangeEmail "dcampbel", "dcampbell", icount
	ChangeEmail "ecampbel", "ecampbell", icount
	ChangeEmail "rcarpent", "rcarpenter", icount
	ChangeEmail "ccontrer", "ccontreras", icount
	ChangeEmail "ocontrer", "ocontreras-perez", icount
	ChangeEmail "ecranfor", "ecranford", icount
	ChangeEmail "jbdavis", "johndavis", icount
	ChangeEmail "vdoss", "vfenn", icount
	ChangeEmail "afitz", "afitzgerald", icount
	ChangeEmail "jgbrown", "jgalt-brown", icount
	ChangeEmail "jgonzale", "jgonzalez", icount
	ChangeEmail "grimsley", "sgrimsley", icount
	ChangeEmail "jharring", "jharrington", icount
	ChangeEmail "wharriso", "wharrison", icount
	ChangeEmail "mhassoun", "mhassouna", icount
	ChangeEmail "phightow", "phightower", icount
	ChangeEmail "shightwr", "shightower", icount
	ChangeEmail "holcombe", "sholcombe", icount
	ChangeEmail "janousek", "sjanousek", icount
	ChangeEmail "wpjones", "wjones", icount
	ChangeEmail "dcking", "davidking", icount
	ChangeEmail "dking", "donnaking", icount
	ChangeEmail "tbmathis", "terimathis", icount
	ChangeEmail "mccorvey", "bmccorvey", icount
	ChangeEmail "mmcdanie", "mmcdaniel", icount
	ChangeEmail "smcduffi", "smcduffie", icount
	ChangeEmail "mcfarlan", "jmcfarland", icount
	ChangeEmail "mcgruder", "lmcgruder", icount
	ChangeEmail "hnewberr", "hnewberry", icount
	ChangeEmail "jnewberr", "jnewberry", icount
	ChangeEmail "joburks", "joliver-burks", icount
	ChangeEmail "eperez", "eperez-miller", icount
	ChangeEmail "brathbur", "brathburn", icount
	ChangeEmail "robinson", "brobinson", icount
	ChangeEmail "droundtr", "droundtree", icount
	ChangeEmail "kscarbor", "kscarborough", icount
	ChangeEmail "senapati", "ssenapati", icount
	ChangeEmail "senkbeil", "msenkbeil", icount
	ChangeEmail "tsheppar", "tsheppard", icount
	ChangeEmail "mspurloc", "mspurlock", icount
	ChangeEmail "steinber", "msteinberg", icount
	ChangeEmail "dthompso", "dthompson", icount
	ChangeEmail "jthompso", "jthompson", icount
	ChangeEmail "thornton", "bthornton", icount
	ChangeEmail "mtreadwa", "mtreadway", icount
	ChangeEmail "lvassili", "lvassiliou", icount
	ChangeEmail "jhellens", "jvonhellens", icount
	ChangeEmail "mrwillia", "mrwilliams", icount
	ChangeEmail "mwilliam", "mwilliams", icount
	ChangeEmail "twilliam", "twilliams", icount
	ChangeEmail "smwilson", "suewilson", icount
	ChangeEmail "windmoll", "jwindmoller", icount
	MsgBox "Number of e-mail addresses updated:" & iCount
End If
   

   ' Clean up
   Set objContact = Nothing
   Set objContacts = Nothing
   Set objContactsFolder = Nothing