问题
Hello Stackoverflow community.
My goal is to write a macro that finds unknown name (or both names written like so "Firstname Secondname") and surname (or both surnames written like so "Firstsurname-Secondsurname") in previously opened/active Word document - there will be only one Word document opened on the computer at the time. I want to find and copy the name and surname from point 2.
Next the macro should copy this name and paste it into the cell A12 in excel"s .activesheet. Only one excel workbook will be opened on the computer at the time.
The structure of the word document is quite consistent and apart from names and personal/id numbers everything stays the same, but no word bookmarks are created. I've found the text that never changes in point 1. = "REGON 364061169, NIP 951-24-09-783,". It's before the name+surname I want to find and copy - I hope it helps.
But also the text "2. " is directly before the name+surname I want to copy and although in the whole contract the string "2. " appears over 20 times, this is the 1st "2. " occurence that precedes name+surname I want to copy and paste into excel's cell.
Name+surname changes all the time, is unknown and has different number of words/characters every time.
Sub FindNames()
'Variables declaration
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim ExcelApp As Excel.Application
Dim MySheet As Worksheet
Dim TextToFind As String
Dim FirstName As String
Dim Rng As Word.Range
Dim StartPos As Long
Dim EndPos As Long
Application.ScreenUpdating = False
TextToFind = "REGON 364061169, NIP 951-24-09-783," 'this text length is 21 caracters
'Assigning object variables
Set WordApp = GetObject(, "Word.Application")
Set ExcelApp = GetObject(, "Excel.Application")
Set WordDoc = WordApp.ActiveDocument
Set MySheet = Application.ActiveWorkbook.ActiveSheet
'Set MySheet = ExcelApp.ActiveWorkbook.ActiveSheet
Set Rng = WordApp.ActiveDocument.Content
'InStr function returns a Variant (Long) specifying the position of the _
first occurrence of one string within another.
StartPos = InStr(1, Rng, TextToFind) 'here we get 1420, we're looking 4 "TextToFind"
EndPos = InStr(StartPos, Rng, "§ 1. ") 'here we get 2742, we're looking 4 ",00zł"
If StartPos = 0 Or EndPos = 0 Then
MsgBox ("Client's names were not found!")
Else
StartPos = StartPos + Len(TextToFind) 'now start position is reassigned at 1455;
FirstName = Mid(Rng, StartPos, EndPos - StartPos)
End If
'len(Firstname)
End Sub
This is the best I can write, but I cannot isolate only name+surname from the bigger variable = FirstName.
My version of the code provided by @PeterT, which is not working for me.
Rng.SetRange Start:=StartPos, End:=EndPos
Debug.Print Rng.Paragraphs.Count
If StartPos = 0 Or EndPos = 0 Then
MsgBox ("Client's names were not found!")
'finding the paragraphs that follow the TextToFind1
Else
For Each Para In Rng.Paragraphs
'how to identify the second paragraph?
'these are not .ListParagraphs, they're normal paragraphs
'If Para.Range.ListParagraphs.Count = 1 Then
If Para.Range.Paragraphs.Count = 2 Then
'how to access the second paragraph?
'If Para.Range.ListFormat.ListValue = 2 Then
'Para.Range.Paragraphs(1).Next(Count:=1).Range
'If Para.Range.Paragraphs.Count = 2 Then
Debug.Print "Name = " & Para.Range.Words(1) & _
", Surname = " & Para.Range.Words(2)
End If
Next Para
End If
I can't access second paragraph and extract the "Michał Łukasz ROESLER" string.
I'd also like to extract "Katarzyna Paula STANISZKIS-KRAWCZYK" from the third paragraph in the Rng. Both of them are on the first page of the document.
回答1:
This answer is deliberately separate from my previous example. That other example is based on finding paragraphs formatted as
ListParagraphs, and remains valid if your search must include that formatting style.This answer assumes the numbered paragraphs are simply regular paragraphs (albeit >indented and numbered). No error checking is performed in this example, e.g. if the >paragraph is not numbered or the names are located elsewhere in the paragraph.
By setting up the searchRange in the manner below, you are assured that the first paragraph is the one containing your search term. In this case, it's the paragraph for Item 1. Since the searchRange is defined using the search term, you're assured that the name is in the next paragraph. No loop is necessary.
Option Explicit
Sub FindNames2()
Dim textToFind As String
textToFind = "REGON 364061169, NIP 951-24-09-783,"
Dim searchArea As Word.Range
Set searchArea = ThisDocument.Content
Dim startPos As Long
Dim endPos As Long
startPos = InStr(1, searchArea, textToFind)
If (startPos = 0) Then Exit Sub
'--- adjust the area to start from where we found the text
' until the end of the document
searchArea.SetRange Start:=startPos, End:=searchArea.End
'--- we want the name at the start of the very next paragraph
' (the current paragraph with the text to find is paragraph 1)
Dim theParagraph As Word.Paragraph
Set theParagraph = searchArea.Paragraphs(2)
Dim itemNumber As Long
Dim firstName As String
Dim lastName As String
itemNumber = CLng(Trim(theParagraph.Range.Words(1)))
firstName = Trim$(theParagraph.Range.Words(3))
lastName = Trim$(theParagraph.Range.Words(4))
Debug.Print "Name = " & firstName & " " & lastName & " in Item #" & itemNumber
End Sub
A couple things to note from additional example in the OP.
- The
endPosmay be zero, even if the search text is found. My testing showed that checking thestartPoswas sufficient. - When accessing a
Word(3), for example, the returned text may have whitespace on one or both sides of the word. Using theTrim$function removes that whitespace. - You can access the name in the paragraph below by incrementing from
Paragraphs(2)toParagraphs(3).
回答2:
This example code assumes you are executing the macro from the MS Word document.
Option Explicit
Sub FindNames()
Dim textToFind As String
textToFind = "REGON 364061169, NIP 951-24-09-783,"
Dim searchArea As Word.Range
Set searchArea = ThisDocument.Content
Dim startPos As Long
Dim endPos As Long
startPos = InStr(1, searchArea, textToFind)
If startPos = 0 Then Exit Sub
'--- adjust the area to start from where we found the text
' until the end of the document
searchArea.SetRange Start:=startPos, End:=searchArea.End
'--- now find the list paragraphs that follow the text
Dim para As Word.Paragraph
For Each para In searchArea.Paragraphs
'--- identify the list paragraph
If para.Range.ListParagraphs.Count = 1 Then
'--- find the second item in the list
If para.Range.ListFormat.ListValue = 2 Then
Debug.Print "Name = " & para.Range.Words(1) & _
", Surname = " & para.Range.Words(2)
End If
End If
Next para
End Sub
回答3:
The best way to do this is create a Word.Range, search the range, then adjust it to capture the names.
Dim srchRng as Word.Range
Dim thisDoc as Word.Document: Set thisDoc = Word.ActiveDocument
Set srchRange = thisDoc.Content
With srchRange.Find
.Text = "REGON 364061169, NIP 951-24-09-783,"
.Execute
If .Found = True Then
srchRange.MoveEndUntil Cset:="."
srchRange.MoveEnd wdWord, 3
If srchRange.Words.Last.Next.Text = "-" Then
srchRange.MoveEnd wdWord, 2
End If
Dim nameStart As Long
nameStart = InStr(1, srchRange.Text, "2. ")
Dim fullName As String
fullName = Mid(srchRange.Text, nameStart + 3)
End If
End With
Debug.Print fullName
来源：https://stackoverflow.com/questions/59934259/find-unknown-name-and-surname-in-opened-word-document-copy-it-and-paste-into-th