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

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

   ' Prompt for old and new company names
   strOldCo = InputBox("Enter the old category name.")
   strNewCo = InputBox("Enter the new category name.")
   
   iCount = 0
   
   respond = MsgBox("Begin Updating Category?", vbOKCancel)
   If respond = 2 Then
      MsgBox "Exiting without updating contacts."
   Else

   ' Process the changes
   For Each objContact In objContacts
      If TypeName(objContact) = "ContactItem" Then
         If InStr(1,objContact.Categories,strOldCo) > 0 Then
            objContact.Categories = Replace(objContact.Categories, strOldCo, strNewCo)
            objContact.Save
            iCount = iCount + 1
         End If
      End If
   Next
   
   MsgBox "Number of contacts updated:" & iCount
   End If
   

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