搜索大量文件并根据搜索字符串将某些行提取到单独的单个文件中答案

【问题标题】：Search across a large number of files and extract certain rows into a separate single file based on search string搜索大量文件并根据搜索字符串将某些行提取到单独的单个文件中
【发布时间】：2020-09-27 13:47:50
【问题描述】：

我不熟悉在 Microsoft Word 中使用宏和 VBA 以及“编程”。

我有超过 100 个独立的 Microsoft Word 文件，其名称结构为“ABC - XXXX.docx”。它们的范围从“ABC - 1800.docx”到 ABC - 2020.docx”

在这些文件中的每一个中都有一个大表（具有可变的但很大的行数）。

我希望能够一次（批量）搜索所有这些文件，以查找和提取（但不删除）包含特定字符串的行 - 例如“需要日期”。这些行应该被放入一个名为“XYZ-Exceptions.docx”的新文件中。

我希望能够复制整行（由 10 列组成）并保留列中数据的格式。搜索字符串可以在行中的任何位置和任何列中。

如果这个“提取”文件可以按最多三列排序，那就更好了。

我还有一个单独的需求，需要从第二列有空白的所有文件中提取所有行。

关于使用什么代码结构、语法和功能来简单地处理这个问题的一些指导会非常有帮助。

谢谢。

【问题讨论】：

这是一个非常雄心勃勃的初学者项目。为陡峭的学习曲线做好准备。关于处理文件夹的文件有很多信息，这里有一页：exceloffthegrid.com/vba-code-loop-files-folder-sub-folders 在每个文档中，如果只有一个表，那么ActiveDocument.Tables(1) 应该让您访问它。当您确实有一些工作代码时，请发布一个新线程，我们可以为您提供进一步的帮助。

标签： vba ms-word

【解决方案1】：

您的帖子中有两个项目。请每个线程一个项目。

对于第一个项目：

Sub Demo()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDocTgt As Document, wdDocSrc As Document
strFolder = GetFolder: If strFolder = "" Then Exit Sub
Set wdDocTgt = Documents.Add
'Find all files whose names begine with "ABC - "
strFile = Dir(strFolder & "\ABC - *.doc", vbNormal)
While strFile <> ""
  Set wdDocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDocSrc.Range.Tables(1).Range
    'Find all rows containing "Date Needed"
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "Date Needed"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
    End With
    Do While .Find.Execute
      If .Information(wdWithInTable) = True Then
      'Replicate the row in the output document
        wdDocTgt.Range.Characters.Last.FormattedText = .Duplicate.Rows(1).Range.FormattedText
      Else
        Exit Do
      End If
      .Collapse wdCollapseEnd
    Loop
  End With
  wdDocSrc.Close SaveChanges:=False
  strFile = Dir()
Wend
With wdDocTgt
  'Sort the table
  .Tables(1).Sort ExcludeHeader:=False, CaseSensitive:=False, _
    FieldNumber:="Column 1", SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, _
    FieldNumber2:="Column 2", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:=wdSortOrderAscending, _
    FieldNumber3:="Column 3", SortFieldType3:=wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending
  'Save the output document
  .SaveAs2 FileName:=StrPth & StrFld & "\XYZ - Exceptions.docx", Fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
End With
Set wdDocSrc = Nothing: Set wdDocTgt = 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

【讨论】：