Excel 读取Word中指定的内容写到Excel单元格中

Excel 读取Word中指定的内容写到Excel单元格中

 
Sub 抓取数据_Click()
  Dim wordApp As Object, docWord As Object
  Dim strPath As String
  Dim i As Long
strPath = ThisWorkbook.Path & "\提取模板.docx"
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
Set docWord = wordApp.Documents.Open(strPath) '打开这个Word文件！
i = i + 1
GetData docWord, i
docWord.Close ' 关闭文件
Set wordApp = Nothing

End Sub


Public Function GetData(doc As Object, lngRow As Long)
Dim strText As String
Dim strStart As String
Dim strEnd As String
strStart = "授权证号-"
strEnd = "号"
With doc.Content.Find
    .Text = "(" & strStart & ")(*)(" & strEnd & ")"
    .MatchWildcards = True
   Do While .Execute
      strText = Replace(Replace(.Parent, strStart, ""), strEnd, "")
      ActiveSheet.Cells(lngRow, 1).Value = strText
   Loop
End With


strStart = "组织"
strEnd = "第1届"
With doc.Content.Find
    .Text = "(" & strStart & ")(*)(" & strEnd & ")"
    .MatchWildcards = True
   Do While .Execute
      strText = Replace(Replace(.Parent, strStart, ""), strEnd, "")
      ActiveSheet.Cells(lngRow, 2).Value = strText
   Loop
End With

End Function