怎么能运用excel的vba读取word文档中的内容

Sub AAA()
    Dim FilePath As String   '要读取的文件路径
    Dim S1       As String   '文档的内容
    Dim S2       As String   '提取到的内容
    Dim Ar       As Variant  '用于保存最终结果
    Dim L1       As Long     '记录当前查找到的字符位置
    FilePath = Application.GetSaveAsFilename(fileFilter:="Word文档,*.doc;*.docx")
    If FilePath = "False" Then MsgBox "您没有选择文件，将退出程序。": Exit Sub
    With CreateObject("word.application")
        With .Documents.Open(FilePath, True, True)
            S1 = .Content
            .Close False
        End With
        .Quit
    End With
    L1 = InStr(S1, "<")  '第一个 < 位置
    Do Until L1 = 0
        If Len(S2) <> 0 Then
            S2 = S2 & "Crazy0qwer" & Mid(S1, L1 + 1, InStr(L1, S1, ">") - L1 - 1)
        Else
            S2 = Mid(S1, L1 + 1, InStr(L1, S1, ">") - L1 - 1)
        End If
        L1 = InStr(L1 + 1, S1, "<")
    Loop
    Ar = Split(S2, "Crazy0qwer")
    Range("A1").Resize(UBound(Ar) + 1) = Application.Transpose(Ar)
End Sub

Dim Wdapp As Object
Dim WdDoc As Object
Dim UserFile As String
Dim Wkbk As Workbook
Dim Sht As Worksheet
On Error Resume Next

Dim WordWasNotRunning

Set Wdapp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
WordWasNotRunning = True
Err.Clear
Set Wdapp = CreateObject("Word.Application")
End If

UserFile = ActiveWorkbook.Path & "\mydoc\" & "120.doc"

Set WdDoc = Wdapp.Documents.Open(UserFile)
'Wdapp.Visible = True

'
Set Wkbk = ActiveWorkbook
Set Sht = Wkbk.Sheets("Sheet1")

'
Dim i As Integer
Dim n, NewRow
'
Dim GetStr(1 To 6) As String

'第一段处理，多段用循环
GetStr(1) = WdDoc.Paragraphs(1).Range

要点：VBA打开Word文件，再用Find或正则表达式匹配