Outlook: Cleaning up contacts

I love my BlackBerry.

I hate manually cleaning up after the fact when it snargleblatts itself inside Outlook.

Here's a quick-and-dirty macro I wrote to clean up after it snargleblatted my contact list by adding the string "(Home)" and "(Work)" to the names of some of my contacts without asking.

Sub AdjustContactName()
On Error Resume Next
  Dim ns As NameSpace
  Dim fld As Folder
  Dim contact As ContactItem
  Dim items As Outlook.items
  Dim i As Integer
  i = 0
  Dim changeflag As Boolean
  changeflag = False

  Set ns = Application.GetNamespace("MAPI")
  Set fld = ns.GetDefaultFolder(olFolderContacts)
  Set items = fld.items
  For Each contact In items
      If InStr(1, contact.FullName, "(Home)") Then
          contact.FullName = Replace(contact.FullName, "(Home)", "")
          changeflag = True
          i = i + 1
      End If
    
      If InStr(1, contact.FullName, "(Work)") Then
          contact.FullName = Replace(contact.FullName, "(Work)", "")
          changeflag = True
          i = i + 1
      End If
    
      If InStr(1, contact.FileAs, "(Home),") Then
          contact.FileAs = Replace(contact.FileAs, "(Home),", "")
          changeflag = True
          i = i + 1
      End If
    
      If InStr(1, contact.FileAs, "(Work),") Then
          contact.FileAs = Replace(contact.FileAs, "(Work),", "")
          changeflag = True
          i = i + 1
      End If
    
      If changeflag Then
          contact.Save
          changeflag = False
      End If
  Next

  MsgBox ("Done." + vbCrLf + "Counted: " + CStr(i))

  Set ns = Nothing
  Set fld = Nothing
  Set contact = Nothing
  Set items = Nothing

End Sub