vba获取word文档中的标题

今天在看协议文档的时候，发现协议条目太多，不想每次写一个就到文档中找一个，我想把条目都写成以条目名称为名的txt中，这样放在项目中就可以做一个看一个，做完删除或者保留资料以后翻看也都是可以的，非常方便

于是写了个vba来处理这些word数据

下面见代码

Sub 六级标题全部写入txt()

    Dim wdSty$, strTxt$
    
    wdSty = "标题 6"
    
    With Selection
        .HomeKey unit:=wdStory, Extend:=wdMove '光标移到文档首
        .Find.ClearFormatting
        .Find.Style = ActiveDocument.Styles(wdSty) '设置查找文本的样式为wdSty(“标题1”)
    End With

    
    Open "D:lcx6.txt" For Output As #1
    
    
    '循环查找文档里所有为“标题1”样式的段落，
    
    Do While Selection.Find.Execute(findtext:="*^13", MatchWildcards:=True, Format:=True)
    
        strTxt = Selection.Text '获取符合样式的文本
        
        '写入文件
        Print #1, strTxt
        
        Selection.Move unit:=wdWord, Count:=1
        
        If Selection.MoveRight <> 1 Then '文档尾退出
            Exit Do
        Else
            Selection.MoveLeft
        End If
    Loop
    
    Close #1

End Sub




Sub 根据标题写入txt()

    Dim path As String, FileName As String, i As Integer, ic, flag
    
    ic = ActiveDocument.Paragraphs.Count
     
    Debug.Print ic
    
    flag = 0
    
    For i = 1 To ic
        
'        Debug.Print ActiveDocument.Paragraphs(i).Style
    
        If ActiveDocument.Paragraphs(i).Style = "标题 6" Then
            
            If flag > 0 Then Close #1
        
            Open "D:lcx" & ActiveDocument.Paragraphs(i).Range & ".txt" For Output As #1
            
            flag = flag + 1
        
            Debug.Print ActiveDocument.Paragraphs(i).Range
        
        ElseIf flag > 0 Then
            
            Print #1, ActiveDocument.Paragraphs(i).Range
            
        End If
        
    Next i
    
    If flag > 0 Then Close #1
    
    Debug.Print "条目总数：" & flag
    
End Sub