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