Programatic search and replace of contacts/notes field
Posted on 2004-10-13
Within my contacts list, there was a corruption which has caused a block of text to be put in the notes field of every contact. There are some 600-odd contacts, so I'm not crazy about doing a manual removal of the text.
I tweaked some code I found to do a search and replace to remove the text (below), but after I ran into problems I realized that the notes field was some sort of rich text field.. so string ops won't work on it.
How can I adapt the code to work on such a field?
Dim strOld As String
Dim strNew As String
Dim olApp As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olMatchedItems As Object
Dim objItem As Object
Dim strCriteria, strNotes As String
Dim i, ipos As String
strOld = "-----Original Message"
strNew = ""
Set olApp = New Outlook.Application
Set olNameSpace = olApp.GetNamespace("MAPI")
Set olFolder = olNameSpace.GetDefaultFolder(olFolderContacts)
'strCriteria = "[Company] = '" & strOld & "'"
'Set olMatchedItems = olFolder.Items.Restrict(strCriteria)
'Set olMatchedItems = olFolder.Items.all
'If olMatchedItems.Count = 0 Then Exit Sub
For Each objItem In olFolder.Items
strNotes = objItem.Notes
ipos = InStr(0, strOld, strNotes)
If ipos > 0 Then
strNew = Left(strNotes, ipos - 1)
i = MsgBox(strNew, vbOKOnly, objItem.FullName)
'objItem.Notes = strNew
'objItem.CompanyName = strNew