Listing 1: The ConvertEmailDisplayToAddress Subroutine
NONEXECUTABLE

Sub ConvertEmailDisplayToAddress()
    Dim objApp As Application
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim colContacts As Items
    Dim objItem As Object
    Dim strAddress As String
        
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder
    If Not objFolder Is Nothing Then
        Set colContacts = objFolder.Items
        For Each objItem In colContacts
            If objItem.Class = olContact Then
                With objItem
                    If .Email1AddressType = "SMTP" And _
                      .Email1DisplayName <> .Email1Address Then
                        strAddress = .Email1Address
                        .Email1Address = ""
                        .Email1Address = strAddress
                    End If
                    If .Email2AddressType = "SMTP" And _
                      .Email2DisplayName <> .Email2Address Then
                        strAddress = .Email2Address
                        .Email2Address = ""
                        .Email2Address = strAddress
                    End If
                    If .Email3AddressType = "SMTP" And _
                      .Email3DisplayName <> .Email3Address Then
                        strAddress = .Email3Address
                        .Email3Address = ""
                        .Email3Address = strAddress
                    End If
                    If Not .Saved Then
                        .Save
                    End If
                End With
            End If
        Next
    End If
    
    Set objItem = Nothing
    Set colContacts = Nothing
    Set objFolder = Nothing
    Set objNS = Nothing
    Set objApp = Nothing
End Sub