打开Word文档，复制特定的文本，粘贴到Excel电子表格

我正在尝试打开一个VBA脚本来打开一个单词文档，查找一个看上去像“TPXXXX”（其中“X”是数字）的单词，然后将该文本粘贴到Excel电子表格中。 我可以打开文档这个词，但是我无法select和find我需要的文本。 到目前为止，我有这个部分：

Sub Copy() 'Create variables Dim Word As New Word.Application Dim WordDoc As New Word.Document Dim Doc_Path As String Dim WB As Workbook Dim WB_Name As String Doc_Path = "C:\Path\To\File.docx" Set WordDoc = Word.Documents.Open(Doc_Path) 'Find text and copy it (part that I am having trouble with) Selection.Find.ClearFormatting With Selection.Find .Text = "TP" .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False End With Selection.Find.Execute Selection.EscapeKey Selection.MoveLeft Unit: wdCharacter , Count:=2 Selection.MoveRight Unit: wdCharacter , Count:=4 Selection.Copy 'Open excel workbook and paste WB_Name = Application.GetOpenFilename(",*.xlsx") Set WB = Workbooks.Open(WB_Name) WB.Sheets("Sheet1").Select Range("AB2").Select ActiveSheet.Paste WordDoc.Close Word.Quit End Sub 

任何人都可以给我一些指针？

Answer 1

这是Excel版本：

 Sub CopyTPNumber() 'Create variables Dim Word As New Word.Application Dim WordDoc As New Word.Document Dim r As Word.Range Dim Doc_Path As String Dim WB As Excel.Workbook Dim WB_Name As String Doc_Path = "C:\temp\TestFind.docx" Set WordDoc = Word.Documents.Open(Doc_Path) ' Set WordDoc = ActiveDocument ' Create a range to search. ' All of content is being search here Set r = WordDoc.Content 'Find text and copy it (part that I am having trouble with) With r .Find.ClearFormatting With .Find .Text = "TP[0-9]{4}" .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .Execute End With .Copy ' Debug.Print r.Text End With 'Open excel workbook and paste WB_Name = Excel.Application.GetOpenFilename(",*.xlsx") Set WB = Workbooks.Open(WB_Name) WB.Sheets("Sheet1").Select Range("AB2").Select ActiveSheet.Paste WordDoc.Close Word.Quit End Sub 

Answer 2

这可能会让你开始：

 Selection.Find.ClearFormatting With Selection.Find .Text = "TP[0-9]{4}" .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .Execute End With Selection.Copy 

我使用了通配符匹配.MatchWildcards = True 。 匹配的模式由.Text = "TP[0-9]{4}" —与“TP”紧跟四位数字匹配。 如果您的应用程序中的位数不同，请用{3,5}replace{4} {3,5} 。

希望有所帮助