Word VBA如何检查AutoCorrect.Entries是否存在指定自动更正条目

AutoCorrect.Entries集合没有内置的快速检索方法，直接调用AddRichText时若条目名重复会无提示覆盖原有配置，以下两种方案可实现添加前的存在性校验，优先使用错误捕获方案，性能远高于全量遍历。

方案1：错误捕获法（推荐，性能最优） #

利用VBA错误捕获机制，直接尝试读取目标名称对应的条目对象，若未抛出错误则说明条目已存在。该方案无需遍历全量条目，无论自动更正条目总量多少都可瞬间返回结果，适合绝大多数场景。
首先编写可复用的判断函数：

Function AutoCorrectEntryExists(entryName As String) As Boolean
    Dim testEntry As AutoCorrectEntry
    On Error Resume Next
    Set testEntry = AutoCorrect.Entries(entryName)
    AutoCorrectEntryExists = (Err.Number = 0)
    On Error GoTo 0
    Set testEntry = Nothing
End Function

方案2：全集合遍历法（兼容旧版本Word） #

如果需要兼容Word 2003及更早版本，可遍历全集合匹配条目名称，缺点是自动更正条目数量较多（数百条以上）时会出现明显卡顿。

Function AutoCorrectEntryExistsTraverse(entryName As String) As Boolean
    Dim entry As AutoCorrectEntry
    AutoCorrectEntryExistsTraverse = False
    ' 采用不区分大小写匹配，和Word原生自动更正匹配逻辑一致
    For Each entry In AutoCorrect.Entries
        If StrComp(entry.Name, entryName, vbTextCompare) = 0 Then
            AutoCorrectEntryExistsTraverse = True
            Exit For
        End If
    Next entry
    Set entry = Nothing
End Function

改造后的完整可运行代码 #

在原有逻辑基础上补充了空输入判断、重复条目确认覆盖逻辑，避免误操作覆盖原有配置：

Sub AutoCorrection()
    Dim selectedRange As Range
    Dim entryName As Variant
    Dim isExist As Boolean

    Set selectedRange = Selection.Range
    ' 校验选中内容长度
    If Len(selectedRange.Text) < 2 Then
        MsgBox "Select text for autocorrect", vbOKOnly, "Nothing Selected"
        Exit Sub
    End If

    ' 获取用户输入的条目名称
    entryName = InputBox(selectedRange.Text, "Name for this autocorrect?")
    ' 处理用户点击取消、输入为空的场景
    If entryName = "" Then Exit Sub

    ' 执行存在性校验
    isExist = AutoCorrectEntryExists(CStr(entryName))
    If isExist Then
        Dim userConfirm As VbMsgBoxResult
        userConfirm = MsgBox("Autocorrect entry named [" & entryName & "] already exists, overwrite it?", vbYesNo + vbExclamation, "Duplicate Entry")
        If userConfirm = vbNo Then Exit Sub
        ' 确认覆盖则先删除原有条目
        AutoCorrect.Entries(CStr(entryName)).Delete
    End If

    ' 添加富文本自动更正条目
    AutoCorrect.Entries.AddRichText Name:=CStr(entryName), Range:=selectedRange
    MsgBox "Autocorrect entry added successfully", vbOKOnly, "Operation Complete"
End Sub

Function AutoCorrectEntryExists(entryName As String) As Boolean
    Dim testEntry As AutoCorrectEntry
    On Error Resume Next
    Set testEntry = AutoCorrect.Entries(entryName)
    AutoCorrectEntryExists = (Err.Number = 0)
    On Error GoTo 0
    Set testEntry = Nothing
End Function

注意：自动更正条目名称匹配默认不区分大小写，校验逻辑无需额外处理大小写差异。

内容的提问来源于stack exchange，提问作者first care