请问怎么把Word中部分内容提取到Execl里

lycl123096

      以前做的说明书,现在模板换了,想批量把说明书几个关键词提取到EXCELL中,然后用新的模板生成说明书,说明书有几千份,哪位大侠能帮忙想下办法,小弟在此谢过了.
附件是将人（Human）3-硝基酪氨酸（3-NT）-NEWA文件中标红位置的内容提取出来的示例.

gbgbxgb

上个图片，等高手：

duquancai

gbgbxgb 发表于 2016-6-1 11:50
上个图片，等高手：

你的问题描述不清楚。下面是根据word文档名:“人（Human）3-硝基酪氨酸（3-NT）-NEWA.pdf.doc" 运行的结果。自己修正吧！Sub 提取关键词()
Dim Matches As Object, Matche As Variant, n%, myString As Range, t As String, t1 As String
Dim reg As Object
Set reg = CreateObject("vbscript.regexp")
Set myString = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
Application.ScreenUpdating = False
     t = t & Chr(13)
    With reg
        .Pattern = "(?:8 nmol/L)|(?:人?[\(（]?Human[^\r]+[\)）])"
        .Global = True: .IgnoreCase = False: .MultiLine = True
        Set Matches = .Execute(myString)
        If Not Matches Is Nothing Then
            For Each Matche In Matches
                n = n + 1
                t1 = Matche
                If Right(t1, 1) <> Chr(13) Then t1 = t1 & Chr(13)
                If InStr(t, vbTab & t1) > 0 Then t1 = "*" & t1
                t = t & n & vbTab & t1
              Next
        End If
    End With
Application.ScreenUpdating = True
Set reg = Nothing: Set myString = Nothing
t = "提取到的内容：共" & n & "项" & t
Documents.Add.Content.Text = t
End Sub