在打开的Word文档中查找未知的名称和姓氏，将其复制并粘贴到具有Excel VBA的excel .activesheet中的单元格A12中 [英] Find unknown name and surname in opened Word document, copy it and paste into the cell A12 in excel .activesheet with excel VBA
问题描述
你好Stackoverflow社区.
我的目标是编写一个宏，该宏在先前打开的/活动的Word文档中查找未知名称(或两个名称都这样写为"Firstname Secondname")和姓氏(或两个名称都这样写为"Firstsurname-Secondsurname")-届时在计算机上只能打开一个Word文档.我想找到并复制第2点的名称和姓氏.
接下来，宏应复制此名称并将其粘贴到excel的.activesheet中的单元格A12中.届时计算机上将只打开一个excel工作簿.
单词文档的结构非常一致，除了名称和个人/身份证号码外，其他所有内容都保持不变，但未创建单词书签.我发现文本永远不会在点1发生变化.="REGON 364061169，NIP 951-24-09-783，". 在我要查找和复制的姓名+姓氏之前-希望能帮上忙.
在我要复制的名称和姓氏之前，也直接出现了文本"2."，尽管在整个合同中字符串"2."出现了20次以上，但这是第一次出现在"2."之前我要复制并粘贴到excel单元格中的名字和姓氏.
姓名+姓氏一直在变化，是未知的，并且每次都有不同的单词/字符数.
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
这是我能写的最好的，但是我不能从更大的变量= FirstName中仅隔离name + surname.
我的@PeterT提供的代码版本对我不起作用.
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
我无法访问第二段并提取MichałŁukaszROESLER"字符串.
我还要从Rng的第三段中提取"Katarzyna Paula STANISZKIS-KRAWCZYK".两者都在文档的首页上.
此答案与我之前的示例故意不同.另一个例子 基于查找格式为
ListParagraphs的段落，并且 如果您的搜索必须包含该格式样式，则该字段仍然有效.此答案假设编号的段落只是普通段落(尽管>缩进并编号).在此示例中，不执行错误检查，例如如果>段落未编号或名称位于段落的其他位置.
通过以下方式设置searchRange，可以确保第一段是包含搜索词的段.在这种情况下，它是项目1的段落.由于searchRange是使用搜索词定义的，因此可以确保名称在下一个段落中.无需循环.
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
在OP中的其他示例中需要注意的几件事.
- 即使找到了搜索文本，
endPos也可能为零.我的测试表明，检查startPos就足够了. - 例如，访问
Word(3)时，返回的文本可能在单词的一侧或两侧都带有空格.使用Trim$函数删除该空格. - 您可以通过将
Paragraphs(2)递增到Paragraphs(3)来访问以下段落中的名称.
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.
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).
这篇关于在打开的Word文档中查找未知的名称和姓氏，将其复制并粘贴到具有Excel VBA的excel .activesheet中的单元格A12中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
