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:\lcx\6.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