Word Placeholder Replacement Macro

Placeholders.bas

Attribute VB_Name = "Placeholders"
Function ValidateInput(value As String) As Boolean
    ValidateInput = Len(Trim(value)) > 0
End Function

' Replace {Placeholders} with text entered by the user
Public Sub ReplacePlaceholders()
    ' VBA Collection does not have .Exists()
    Dim dictionary
    Set dictionary = CreateObject("Scripting.Dictionary")
    
    Dim document As document
    Set document = Application.ActiveDocument
    
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "{[^}]+}"
    re.IgnoreCase = True
        
    Dim matches
    Dim range, key, value As String
    
    ' With a .Global = True RegExp, every replacement of length longer
    ' or shorter than the original match would cause offsets of other
    ' ranges to be off. This approach is inefficient, but effective and
    ' easy to reason about.
    Do While re.Test(ActiveDocument.range.Text)
        Set matches = re.Execute(ActiveDocument.range.Text)
        
        ' There should be exactly one. See comment above.
        For Each match In matches
            ' Get a range within ActiveDocument corresponding to the
            ' regular expression match within the document string.
            Set range = document.range(match.FirstIndex, match.FirstIndex + Len(match.value))
            ' Strip away the surrounding {braces}
            key = Trim(Mid(range.Text, 2, Len(range.Text) - 2))
        
            ' Check the dictionary for previous values
            If dictionary.Exists(key) Then
                value = dictionary(key)
            Else
                ' If the value is missing, get it from the user and save
                ' in the dictionary.
                Do
                    value = InputBox("Enter " + key, "Enter Value")
                Loop While ValidateInput(value) = False
                
                dictionary.Add key, value
            End If
        
            ' Replace the placeholder with its value
            range.Text = value
        Next
    Loop
    
    ' Clean up
    Set re = Nothing
    Set dictionary = Nothing
End Sub