Option Explicit
Public Sub MyTest()
Dim objCI As Outlook.ContactItem
Dim strUser As String
strUser = "Der Peiniger (alias Chef)"
With GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set objCI = .Items.Find("[FirstName] = 'Maxi' AND [LastName] = 'Maus'")
End With
If objCI Is Nothing Then
Call MsgBox("Kontakt nicht gefunden", vbExclamation)
Exit Sub
End If
With objCI
.Body = ContactNoteBody(objCI) & vbNewLine & _
Format$(Date, "yyyy-mm-dd") & " Daten Aktualisiert " & strUser & ": " & vbNewLine
.Save
End With
Set objCI = Nothing
End Sub
Private Function ContactNoteBody(Contact As Outlook.ContactItem) As String
Dim objRegExp As Object
On Error Resume Next
Set objRegExp = CreateObject("VBScript.RegExp")
On Error GoTo 0
If objRegExp Is Nothing Then
ContactNoteBody = Contact.Body
Else
With objRegExp
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "\bHYPERLINK\s+"".+""\s+(.+)\b"
ContactNoteBody = .Replace(Contact.Body, "$1")
End With
Set objRegExp = Nothing
End If
End Function