从充满相同 Word 表格的文件夹中提取特定单元格答案

【问题标题】：Extracting specific cells from a folder full of identical Word tables从充满相同 Word 表格的文件夹中提取特定单元格
【发布时间】：2019-04-02 20:23:59
【问题描述】：

我有一个充满 Word 表单的文件夹，我想从中提取一些关键信息：姓名、数字、日期和单个单元格的内容。我见过导入整个 Word 表格的解决方案，但我不需要表格上的大部分信息。

word中的所有表格都是一样的，除了单元格中的数据，因为人们使用模板来制作这些表格。所有单元格都标记在我真正想要的单元格的右侧。我有一个文件夹，里面装满了这些 Word 文档表格。

我尝试修改此脚本 (Extract Data from Word Document to an Excel SpreadSheet)，但我的 VBA 技能很糟糕，在崩溃之前我只能获取一行数据。

如何从这些word文档中提取包含我想要的数据的特定单元格？我什至很高兴能得到数据所在的整条线。

【问题讨论】：

你的问题太宽泛了。例如，您没有说明如何识别所有必需的内容，涉及每个文档中的哪些表或多少个表。
表格是一张连续的表格。我不知道 Word 如何处理它的表格，但所有数据都在每个文档的同一个位置。如果它在 Excel 中，它将是（例如）单元格 D3、B12 和 D25。

标签： excel vba ms-word

【解决方案1】：

试试下面的 Excel 宏，它从所选文件夹中每个 Word 文档的第一个表格中的 D3、B12 和 D25 单元格中提取 Word 数据。文档名称输出到 A 列，其余数据输出到 B-D 列。每个文件中只有 3 项，但您对“名称、数字、日期和单个单元格的内容”的引用意味着有 4 项。

Sub GetTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, WkSht As Worksheet, r As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
Set WkSht = ActiveSheet: r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.doc", vbNormal)
With wdApp
  'Hide our Word session
  .Visible = False
  'Disable any auto macros in the documents being processed
  .WordBasic.DisableAutoMacros
  While strFile <> ""
    Set wdDoc = .Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    r = r + 1: WkSht.Range("A" & r) = Split(strFile, ".doc")(0)
    With wdDoc
      If .Tables.Count > 0 Then
        With .Tables(1)
          WkSht.Range("B" & r) = Split(.Cell(3, 4), vbCr)(0)
          WkSht.Range("C" & r) = Split(.Cell(12, 2), vbCr)(0)
          WkSht.Range("D" & r) = Split(.Cell(25, 4), vbCr)(0)
        End With
      End If
      .Close SaveChanges:=False
    End With
    strFile = Dir()
  Wend
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing    Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

【讨论】：