如何通过VBA提取并分离AutoTextList域的各组成部分

针对AutoTextList域无法通过Fields(i).Code获取完整代码的问题，下面的VBA宏可以解析域的代码文本，提取出字面文本、样式名、提示文本三个核心参数，同时自动处理引号和多余反斜杠：

Sub ParseAutoTextListFields()
    Dim doc As Document
    Dim fld As Field
    Dim fldCode As String
    Dim literalText As String, styleName As String, tipText As String
    Dim sPos As Integer, tPos As Integer, endPos As Integer
    
    Set doc = ActiveDocument
    
    For Each fld In doc.Fields
        If fld.Type = wdFieldAutoTextList Then
            ' 获取域的完整代码文本
            fldCode = fld.Code.Text
            
            ' 提取字面文本：定位首尾引号间的内容
            literalText = Mid(fldCode, InStr(fldCode, """") + 1, InStr(InStr(fldCode, """") + 1, fldCode, """") - InStr(fldCode, """") - 1)
            
            ' 处理\s参数对应的样式名
            sPos = InStr(fldCode, "\s")
            If sPos > 0 Then
                sPos = sPos + 2
                ' 跳过\s后面的空格
                Do While Mid(fldCode, sPos, 1) = " "
                    sPos = sPos + 1
                Loop
                ' 判断样式名是否带引号
                If Mid(fldCode, sPos, 1) = """" Then
                    endPos = InStr(sPos + 1, fldCode, """")
                    styleName = Mid(fldCode, sPos + 1, endPos - sPos - 1)
                Else
                    ' 不带引号则取到下一个空格、\t或文本末尾
                    endPos = InStr(sPos, fldCode, " ")
                    If endPos = 0 Then endPos = InStr(sPos, fldCode, "\t")
                    If endPos = 0 Then endPos = Len(fldCode) + 1
                    styleName = Mid(fldCode, sPos, endPos - sPos)
                End If
            End If
            
            ' 处理\t参数对应的提示文本
            tPos = InStr(fldCode, "\t")
            If tPos > 0 Then
                tPos = tPos + 2
                ' 跳过\t后面的空格
                Do While Mid(fldCode, tPos, 1) = " "
                    tPos = tPos + 1
                Loop
                ' 判断提示文本是否带引号
                If Mid(fldCode, tPos, 1) = """" Then
                    endPos = InStr(tPos + 1, fldCode, """")
                    tipText = Mid(fldCode, tPos + 1, endPos - tPos - 1)
                Else
                    endPos = InStr(tPos, fldCode, " ")
                    If endPos = 0 Then endPos = Len(fldCode) + 1
                    tipText = Mid(fldCode, tPos, endPos - tPos)
                End If
                ' 去除提示文本中的所有反斜杠
                tipText = Replace(tipText, "\", "")
            End If
            
            ' 这里可以把参数存到变量或写入表格，示例用弹窗展示
            MsgBox "字面文本: " & literalText & vbCrLf & _
                   "样式名: " & styleName & vbCrLf & _
                   "提示文本: " & tipText
        End If
    Next fld
End Sub

核心处理细节 #

• 字面文本：AutoTextList的字面文本必须用引号包裹，直接定位首尾引号提取即可。
• 样式名：自动识别带/不带引号的情况，带引号则剥离引号取中间内容，不带则取到下一个分隔符前的文本。
• 提示文本：处理逻辑和样式名一致，最后额外清除所有反斜杠，解决提示文本带冗余反斜杠的问题。

内容的提问来源于stack exchange，提问作者Charles Kenyon