Word-Dokument öffnen, bestimmten Text kopieren, in Excel-Tabelle einfügen

Question

Ich versuche ein VBA-Skript zu machen, das ein Word-Dokument öffnet, nach einem Wort sucht, das wie "TPXXXX" aussieht, wobei "X" Zahlen sind, und fügt das dann ein Text in eine Excel-Tabelle. Ich kann das Word-Dokument öffnen, aber ich habe Schwierigkeiten, den benötigten Text auszuwählen und zu finden. So weit für diesen Teil habe ich:

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 

Kann mir jemand einige Hinweise geben?

Answer 1

Hier ist die Excel-Version hilft:

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

Dies könnte Ihnen den Einstieg:

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

Ich habe Platzhalter verwendet .MatchWildcards = True entsprechen. Das übereinstimmende Muster wird durch .Text = "TP[0-9]{4}" angegeben --- entspricht "TP" gefolgt von genau vier Ziffern. Wenn die Anzahl der Ziffern in Ihrer Anwendung variiert, ersetzen Sie {4} durch sagen {3,5}.

Hoffnung, die