将包含某个关键字的字符串值从word文档提取到带页码的Excel

我是VBA新手，尝试从word文档中提取一些包含某个关键字的字符串值到Excel。例如，有一些国家代码，如USA.001.01.033592，我想从word文档中提取所有类似国家代码的字符串值，并将它们收集到Excel电子表格中

我将国家代码视为

美国xxx.xx.xxxxxx

JPA.xxx.xx.xxxxxx

FRA.xxx.xx.xxxxxx X代表数字，问题是这些代码在主体段落、段落内的表格和脚注中。另外，当我检索代码时，我还想提取页码

有什么方法可以从主要段落、表格和脚注中立即提取出我想要的数据，以及它们的页码

我有一个粗略的代码草案，但根本不起作用。有人能帮忙吗

这是我的密码：

Option Explicit

Sub Footnotes()

    Dim appExcel As Object
    Dim objSheet As Object
    Dim aRange As Range
    Dim intRowCount As Integer
    intRowCount = 1
    Set aRange = ActiveDocument.Range

    With aRange.Find
    Do
        .Text = "USA." or "JPA." or "FRA."
        .Execute
        If .Found Then
            aRange.Expand Unit:=wdSentence
            aRange.Copy
            aRange.Collapse wdCollapseEnd
            If objSheet Is Nothing Then
               Set appExcel = CreateObject("Excel.Application")
               Set objSheet = appExcel.workbooks.Open("C:\Users\Footnotes.xlsx").Sheets("Sheet1")
               intRowCount = 1
            End If
            objSheet.Cells(intRowCount, 1).Select
            objSheet.Paste
            intRowCount = intRowCount + 1
        End If
        Loop While .Found
    End With

    If Not objSheet Is Nothing Then
    appExcel.workbooks(1).Close True
    appExcel.Quit
    Set objSheet = Nothing
    Set appExcel = Nothing
    End If
    Set aRange = Nothing

End Sub

---

目前，我正在尝试使用word文档中的VBA，但如果最好从excel文件开始，请告诉我。

由于要搜索的模式不同，您可以使用word的

查找带通配符的
。在Word MVP网站上有一个关于这一点的链接。这将允许
Find
返回您正在查找的整个字符串，而无需扩展查找范围

找到范围后，您可以检索要传递到Excel的文本，并使用
信息
属性获取页码

Word文档由许多称为的部分组成。虽然表格只是包含它们的范围的一部分，但脚注包含在单独的故事范围中。下面的代码循环遍历故事范围并检查当前的故事范围。我这样做是为了在需要时可以添加其他类型

你的问题中没有说明你想对页码做什么，所以你需要修改下面的代码

Sub Footnotes()

   Dim appExcel As Excel.Application
   Dim objSheet As Excel.Worksheet
   Dim findRange As Range
   Dim intRowCount As Integer
   Dim pageNum As Long
   
   If objSheet Is Nothing Then
      Set appExcel = CreateObject("Excel.Application")
      Set objSheet = appExcel.workbooks.Open("C:\Users\Footnotes.xlsx").Sheets("Sheet1")
   End If
   intRowCount = 2
   
   'Set findRange = ActiveDocument.Range
   For Each findRange In ActiveDocument.StoryRanges
      With findRange.Find
         .Text = "[UJF][PRS]A.[0-9]{3}.[0-9]{2}.[0-9]{6}"
         .MatchWildcards = True
         Do While .Execute = True
            pageNum = CLng(findRange.Information(wdActiveEndPageNumber))
            objSheet.Cells(intRowCount, 1).Value = findRange.Text
            objSheet.Cells(intRowCount, 2).Value = pageNum
            intRowCount = intRowCount + 1
            findRange.Collapse wdCollapseEnd
         Loop
      End With
   Next findRange

   If Not objSheet Is Nothing Then
      appExcel.workbooks(1).Close True
      appExcel.Quit
      Set objSheet = Nothing
      Set appExcel = Nothing
   End If
   Set findRange = Nothing
End Sub

编辑：
上述代码仅查找问题中列出的国家代码。要查找任何国家代码，请将
find.Text
更改为“[A-Z]{3}.[0-9]{3}.[0-9]{2}.[0-9]{6}”
这是否回答了您的问题？嗨，蒂莫西。非常感谢你。我想对页码做的是，我只想将它们存储在一个单独的列中。所以有两个不同的列“Data”和“Page Num”。我应该修改哪个部分来实现这一点？同样对于当前代码，它在“objSheet.Cells（intRowCount，1.Range.Value=findRange.Text”处中断。它表示参数数目错误或属性赋值无效。@5123-请参阅已编辑的代码。请注意，您需要从2开始
intRowCount
，以避免列标题。非常感谢。你能解释一下为什么它需要“findRagne.Collapse wdCollapseEnd in the while loop？”吗？@alexsmith5123-当找到匹配项时，查找
会将范围重新定义为找到的项的范围。如果你没有折叠范围

查找将不会继续超过该匹配项。