Question

我正在尝试创建一个打开word文档的VBA脚本，查找看起来像“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

这是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}"指定---匹配＆＃34; TP＆＃34;然后是完全四位数。如果您的应用中的位数不同，请将{4}替换为{3,5}。

希望有所帮助

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

2 个答案: