Update Notes field for all contacts in folder

[gmayor]

The following appears to work

Option Explicit
' Graham Mayor - https://www.gmayor.com - Last updated - 05 Nov 2020

Sub AddNote()
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.items
    Dim olItem As Outlook.ContactItem
    Dim i As Long
    Dim strText As String
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    On Error Resume Next
    strText = InputBox("Enter the text to Add to all contacts' notes." & vbCr & vbCr & "Text entered is case sensitive!")
    If strText = "" Then GoTo lbl_Exit
    On Error GoTo 0
    Set olFolder = Session.PickFolder
    Set olItems = olFolder.items
    For i = olItems.Count To 1 Step -1
        Set olItem = olItems(i)
        With olItem
            .Display
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.collapse 1
            If .Body = "" Then
                oRng.Text = strText
            Else
                oRng.Text = strText & vbCrLf
            End If
            oRng.Font.Bold = True 'set font to bold
            oRng.Font.Color = RGB(255, 0, 0) ' set font colour to red
            .Save
            .Close 0
        End With
        DoEvents
    Next i
    lbl_Exit:
    MsgBox strText & vbCr & "added to all items in" & vbCr & olFolder.Name, vbInformation
    Set olFolder = Nothing
    Set olItems = Nothing
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Sub RemoveNote()
    Dim olFolder As Outlook.Folder
    Dim olItems As Outlook.items
    Dim olItem As Outlook.ContactItem
    Dim i As Long
    Dim strText As String
    On Error Resume Next
    strText = InputBox("Enter the text to Remove from all contacts' notes." & vbCr & vbCr & "Text entered is case sensitive!")
    If strText = "" Then GoTo lbl_Exit
    On Error GoTo 0
    Set olFolder = Session.PickFolder
    Set olItems = olFolder.items
    For i = olFolder.items.Count To 1 Step -1
        Set olItem = olItems(i)
        With olItem
            .Display
            If InStr(1, .Body, vbCrLf) > 0 Then
                .Body = Replace(.Body, strText & vbCrLf, "")
            Else
                .Body = Replace(.Body, strText, "")
            End If
            .Save
            .Close 0
        End With
        DoEvents
    Next i
    lbl_Exit:
    MsgBox strText & "removed from" & vbCr & olFolder.Name, vbInformation
    Set olFolder = Nothing
    Set olItems = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub