Help with macro to insert date at the end of oulook contact body

[gmayor]

The following will do what you ask, but it is not clear where you want the extra text or what colour you want for the rest but you should be able to work out how to set the ranges from that shown below.

Public Sub AddDateEnd()
    ' Graham Mayor - https://www.gmayor.com - Last updated - 09 Nov 2020
    Dim olItem As ContactItem
    Dim olInsp As Inspector
    Dim wdDoc As Object
    Dim oRng As Object
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olItem = ActiveInspector.currentItem
        Case olExplorer
            Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select
    With olItem
        .Display
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        If Len(oRng) > 2 Then
            oRng.collapse 0
            oRng.Text = vbCrLf
        End If
        oRng.collapse 0
        oRng.Text = Format(Date, "mm/dd/yyyy") & " Call:" & vbCrLf & Format(Time, "HH.MM ")
        oRng.Paragraphs(1).Range.Font.Color = RGB(0, 128, 0)    'green
        ' place the cursor at the end of what has been inserted to be able to start writing
        oRng.collapse 0
        oRng.Select
        .Save
        '.Close 0 'Do not Close for further inserting text there
    End With
    lbl_Exit:
    Set olItem = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub