在打开的 Word 文档中查找未知姓名和姓氏，将其复制并粘贴到 excel .activesheet 中的单元格 A12 中，并使用 excel VBA

Question

你好 Stackoverflow 社区。

我的目标是编写一个宏，在以前打开/活动的 Word 文档中找到未知名称（或两个名字都写成“Firstname Secondname”）和姓氏（或两个姓氏都写成“Firstsurname-Secondsurname”） - 只有当时在计算机上打开的一个 Word 文档。 我想从第 2 点中查找并复制姓名和姓氏。

接下来，宏应复制此名称并将其粘贴到 excel 的 .activesheet 中的单元格 A12 中。此时计算机上只会打开一个 excel 工作簿。

word文档的结构非常一致，除了姓名和个人/身份证号码外，一切都保持不变，但没有创建单词书签。 我发现第 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

这是我能写的最好的，但我不能只将 name+surname 与更大的变量 = FirstName隔离。

我的@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ł Łukasz ROESLER”字符串。

我也想提取物“是Katarzyna保斯坦尼斯-KRAWCZYK”从第三段Rng 。 它们都在文档的第一页上。

Answer 1

此示例代码假定您正在执行 MS Word 文档中的宏。

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

Answer 2

最好的方法是创建一个Word.Range ，搜索范围，然后调整它以捕获名称。

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

Answer 3

这个答案特意与我之前的例子分开。 另一个示例基于查找格式为ListParagraphs ，如果您的搜索必须包含该格式样式，则该示例仍然有效。

这个答案假设编号的段落只是普通的段落（尽管 > 缩进和编号）。 在此示例中不执行错误检查，例如，如果 > 段落没有编号或名称位于段落中的其他位置。

通过以下面的方式设置searchRange ，您可以确信第一段是包含您的搜索词的段落。 在本例中，它是 Item 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 中的其他示例中需要注意的几件事。

1. 即使找到了搜索文本， endPos也可能为零。 我的测试表明检查startPos就足够了。
2. 例如，在访问Word(3) ，返回的文本可能在单词的一侧或两侧有空格。 使用Trim$函数删除该空格。
3. 您可以通过从Paragraphs(2)增加到Paragraphs(3)来访问下面段落中的名称。