VBA to find specific text in word doc and copy this text from word doc into a cell in excel

问题

Hello stackoverflow community.

What I'm doing until now, is I manually copy a price from the word document, which I previously open, and paste it into an Excel sheet. It is the only .docx file opened at the time on computer, so we just need to find the price in currently opened word file. I'd like U to help me automate this task.

This picture shows the part of the document from where I copy the price. In this example it's 605.000. But I don't know the price before I check it in the word file. The word file is a place where I learn what the price is. The selected text occurs only once in the whole document therefore I need VBA to copy what's after "brutto w kwocie " and up to the first coma. Yes - only the amount of money without decimal values, because they're always ,00. But not only seven signs, because if I had apartment price 1.250.000 then the macro that copies only 7 signs wouldn't work.

Sub Find_Price()
    'Variables declaration
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim TextToFind As String
    Dim ApartmentPrice As String
    Dim Rng As Word.Range
    Application.ScreenUpdating = False
    'This is the text I'm looking for in .ActiveDocument
    TextToFind = "brutto w kwocie "
    'Start Word and create an object
    'Set WordApp = CreateObject("Word.Application")
    'Reference already opened Word document from excel VBA console
    Set WordApp = GetObject(, "Word.Application")
    WordApp.Application.Visible = True
    Set Rng = WordApp.ActiveDocument.Content
    'Set WordDoc = WordApp.ActiveDocument   'I don't know how to finish this line

        Rng.Find.Execute FindText:=TextToFind, Forward:=True     
                'what this "Forward:=True" means??
        If Rng.Find.Found Then
            If Rng.Information(wdWithInTable) Then
              'I don't know how to write this part of the code.
              'Please don't remove my question again - I've researched 16h for this info.
              MsgBox "Price is " & ApartmentPrice & " pln."
            End If
        Else
            MsgBox "Apartment price was not found!"
        End If
    Set ws = ActiveSheet       'currently opened sheet on currently opened.xlsm file
    ws.Range("E27").Activate
    ws.Paste
End Sub

Then I need to strip the number from this ridiculous dot in the middle of the amount, so please help me clear 605.000 into 60500 or 1.250.000 into 1250000.

When I have this number (the price) in my clipboard, I need to paste it into currently opened excel file, into .activesheet (because the name of the excel file and excel sheet will change many times a day). But the destination cell will always be E27 - it will never change.

Thank you guys for all the help.

EDIT 24.01.2020 This is the above mentioned code amended by me to my best abilities.

Sub Find_Corrected()
    'Variables declaration
    'Dim WordApp As Object
    Dim WordApp As Word.Application
    'Dim WordDoc As Object
    Dim WordDoc As Word.Document
    Dim TextToFind As String
    Dim ApartmentPrice As String
    Dim Rng As Word.Range
    Application.ScreenUpdating = False
        'This is the text I'm looking for in .ActiveDocument
        TextToFind = "brutto w kwocie "
        'Start Word and create an object
        'Set WordApp = CreateObject("Word.Application")
        'Reference already opened Word document from excel VBA console
        Set WordApp = GetObject(, "Word.Application")
        Set WordDoc = WordApp.ActiveDocument
        Set Rng = WordApp.ActiveDocument.Content
        WordApp.Application.Visible = True
        'Set WordDoc = WordApp.Documents.Open(FilePath & "Form1.docx")
        'Set WordDoc = WordApp.ActiveDocument     'I don't know how to finish this line  :-(
            Rng.Find.Execute FindText:=TextToFind, Forward:=True
                    'what this "Forward:=True" means??
            With Rng.Find
                .Text = "brutto w kwocie "
                .Execute
                    If .Found = True Then
                        Rng.MoveEnd wdWord, 3
                        Rng.Copy
                        MsgBox "Copied value equals " & Rng.Value & " Roesler conquers."
                    Else
                        MsgBox "Requested range was not found!"
                    End If
            End With
    'Set ws = ActiveSheet       ' currently opened sheet on currently opened.xlsm file
    'ws.Range("E27").Activate
    'ws.Paste
End Sub

And this is the error it returns.

回答1:

You can use the same method that I used in an answer to another of your questions.

Create a range, set it equal to the whole document, search along the range, move until your desired stop range, then move the start of the range up to your numbers.

Dim srchRng as Range
Set srchRng = ActiveDocument.Content

With srchRng.Find
    .Text = "brutto w kwocie "
    .Execute
    If .Found = True Then
        Dim numberStart as Long
        numberStart = Len(srchRng.Text) + 1
        srchRng.MoveEndUntil Cset:=","

        Dim myNum as String
        myNum = Mid(srchRng.Text, numberStart)
    End If
End With

来源：https://stackoverflow.com/questions/59846208/vba-to-find-specific-text-in-word-doc-and-copy-this-text-from-word-doc-into-a-ce

标签

excel

vba

ms-word

copy

paste