在打開的 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)來訪問下面段落中的名稱。