Danke für die Antwort. Hier das Script.

Das Programm ist ein unbekanntes Nischenprodukt.

==CODE NEW MODULE==
Public ada As Boolean

Sub ReplaceText()
Dim wdoc As Word.Document
Dim wapp As Word.Application
Dim wRg As Word.Range
Dim WReplace As Word.Range
Dim ref As String
Dim i As Long
Dim varr As Variant

If ActiveInspector Is Nothing Then Exit Sub

Set wdoc = ActiveInspector.WordEditor
Set wapp = wdoc.Application
Set wRg = wdoc.Range

ada = False
For i = 1 To wapp.NormalTemplate.BuildingBlockEntries.Count
    Set wRg = wdoc.Range
    ref = wapp.NormalTemplate.BuildingBlockEntries(i).Name
    varr = Split(ref, ":", , vbTextCompare)
    Select Case UBound(varr)
    Case 0
        With wRg.Find
            .ClearFormatting
            .MatchCase = False
            .Execute ref
            If .Found Then wapp.NormalTemplate.BuildingBlockEntries(i).Insert wRg: ada = True
        End With
    Case 1
        With wRg.Find
            .ClearFormatting
            .MatchCase = False
            .Execute varr(0)
            If .Found Then
                Set WReplace = wdoc.Range
                With WReplace.Find
                    .ClearFormatting
                    .MatchCase = False
                    .Execute varr(1)
                    If .Found Then wapp.NormalTemplate.BuildingBlockEntries(i).Insert WReplace: ada = True
                End With
            End If
        End With
    End Select
    Set wRg = Nothing
    Set WReplace = Nothing
Next
End Sub

==CODE ThisOutlookSession==

Option Explicit

Public WithEvents objinspectors As Outlook.Inspectors
Public WithEvents mail As Outlook.MailItem

Private Sub Application_Startup()
    Set objinspectors = Application.Inspectors
End Sub

Private Sub mail_Send(Cancel As Boolean)
    ReplaceText
    If ada = True Then
        If MsgBox("Replacing quick part finished, do you want to send the email now?", vbYesNo) = vbYes Then
            Cancel = False
        Else
            Cancel = True
        End If
    End If
End Sub

Private Sub mail_Write(Cancel As Boolean)
    ReplaceText
End Sub

Private Sub objinspectors_NewInspector(ByVal Inspector As Inspector)
    If Inspector.CurrentItem.Class = olMail Then
        Set mail = Inspector.CurrentItem
    End If
End Sub