将多个 Word 文档中的数据复制到一个 Excel 表中

Question

我有大约 4000 个包含表格的 doc 和 docx 文件。我已使用以下脚本将它们导入到一个 excel 表中：

Sub Macro1()
   Dim xl As Object
   Set xl = CreateObject("excel.application")

   xl.workbooks.Add
   xl.Visible = True

   'Here put your path where you have your documents to read:
   myPath = "C:\Users\"  'End with '\'
   myFile = Dir(myPath & "*.docx")

   xlRow = 1
   Do While myFile <> ""
      Documents.Open FileName:=myPath & myFile, ConfirmConversions:=False, _
         ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
         PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
         WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

      xlCol = 0
      For Each t In ActiveDocument.Tables
         For Each r In t.Rows
            For Each c In r.Range.Cells
               myText = c
               myText = Replace(myText, Chr(13), "")
               myText = Replace(myText, Chr(7), "")
               xlCol = xlCol + 1
               xl.activeworkbook.activesheet.Cells(xlRow, xlCol) = myText

            Next c
            xlRow = xlRow + 1
            xlCol = 0
         Next r
      Next t
      ActiveWindow.Close False

      myFile = Dir
   Loop

   xl.Visible = True
End Sub

唯一的问题是文档表格之外有一个日期。由于表格中没有日期，因此它无法获取该日期，而我有一长串没有日期的数据。我怎样才能让它将所有数据或至少将日期也导入到 Excel 表中。如果没有日期，我拥有的数据可能会按任何顺序排列，对我来说毫无用处。

Answer 1

您的评论表明文件名包含您想要的日期。您正在访问变量 myFile 中的文件名。为什么不将其分开以获取日期，并将其插入您想要的位置？例如，您可以将其设置为目标表中的第一个或最后一个单元格。

添加的示例：

尝试将这一新行添加到您的脚本中。

        Next c
        'new
        xl.activeworkbook.activesheet.Cells(xlRow, xlCol + 1) = myFile
        xlRow = xlRow + 1