打开 word 文档，复制特定文本，粘贴到 excel 电子表格

Question

我正在尝试制作一个 VBA 脚本来打开一个 word 文档，寻找一个看起来像 "TPXXXX" 的词，其中 "X" 是数字，然后将该文本粘贴到excel 电子表格。我可以打开 word 文档，但我无法选择和查找我需要的文本。到目前为止，我有：

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

这可能会让您入门：

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" 后跟 exactly 四位数字。如果您的应用程序中的位数有所不同，请将 {4} 替换为 {3,5}.

希望对您有所帮助

Answer 2

这是 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

打开 word 文档，复制特定文本，粘贴到 excel 电子表格

Opening word document, copying specific text, paste into excel spreadsheet

excel

vba

ms-word

ms-office