Microsoft Outlook OLE automation to bulk adjust email display name

I've just written code bellow to adjust email display name from my contacts on Personal Folders > Contacts > Plaxo

Option Explicit

Private Sub cmdExecute_Click()
    Dim blnDirty As Boolean
    Dim objOutlookApplication As Outlook.Application
    Dim objOutlookMAPIFolder As Outlook.MAPIFolder
    Dim objOutlookContactItem As Outlook.ContactItem
    
    Set objOutlookApplication = New Outlook.Application
    Set objOutlookMAPIFolder = objOutlookApplication.GetNamespace("MAPI").Folders("Personal Folders").Folders("Contacts").Folders("Plaxo")
    
    For Each objOutlookContactItem In objOutlookMAPIFolder.Items
        blnDirty = False
        Debug.Print "Verifying " & objOutlookContactItem.FullName
        DoEvents
        If RTrim$(objOutlookContactItem.Email1Address) & vbNullString <> vbNullString Then
            objOutlookContactItem.Email1DisplayName = objOutlookContactItem.FullName & " (" & objOutlookContactItem.Email1Address & ")"
            blnDirty = True
        End If
        If RTrim$(objOutlookContactItem.Email2Address) & vbNullString <> vbNullString Then
            objOutlookContactItem.Email2DisplayName = objOutlookContactItem.FullName & " (" & objOutlookContactItem.Email2Address & ")"
            blnDirty = True
        End If
        If RTrim$(objOutlookContactItem.Email3Address) & vbNullString <> vbNullString Then
            objOutlookContactItem.Email3DisplayName = objOutlookContactItem.FullName & " (" & objOutlookContactItem.Email3Address & ")"
            blnDirty = True
        End If
        If blnDirty Then
            objOutlookContactItem.Save
        End If
    Next
    
    Set objOutlookContactItem = Nothing
    Set objOutlookMAPIFolder = Nothing
    Set objOutlookApplication = Nothing
End Sub

What do you think about this code? Any comment is welcome.

No Comments