VBA excel：在某个select中从MS Word导入表格

我无法将MS Word文档中的表格导入到Excel中。 对于背景，单词文档都是以相同的方式格式化的，在“input”下的信号表中，“输出”标题下的信号表是另一个表格。

我希望能够导入表格，并根据它们在input标题下的输出标题或输出标题将它们拆分到表单之间。 MSWord文档中的安装就像这样

1.1.1input

[表]

1.1.2产出

[表]

1.1.3 Blah de Blah

到目前为止，我已经用下面的代码导入了所有引用信号的表格，但是就我所能得到的结果而言。 任何人都可以帮助我，甚至有可能从select导入？

编辑2/1/17

在ryguy72的评论之后，我更新了代码，以便在Excel中运行代码时从多个选定的Word文档复制表格。 我仍然有这个问题，我不需要文件中的所有表，我只需要能够区分上面提到的单词doc中的Inputs和Outputs部分，并复制这些特定的表。 理想情况下，input将被复制到一张纸上，并将输出复制到另一张纸上，纸张被保存在单词文档之间，从而成为各种数据库。 有没有办法做到这一点？

Sub GetWordDocContentsFromAllWordDocuments() On Error Resume Next Dim oWord As Object Dim vFiles Dim iFile As Integer Dim iTable As Integer Dim tableNo As Integer Dim R As Range vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True) If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled Set oWord = CreateObject("Word.Application") oWord.Visible = False Set R = Worksheets.Add.Range("A1") For iFile = LBound(vFiles) To UBound(vFiles) oWord.Documents.Open vFiles(iFile) tableNo = oWord.ActiveDocument.tables.Count For iTable = 1 To tableNo oWord.ActiveDocument.tables(iTable).Select oWord.Selection.Copy ActiveSheet.Paste R Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) Next oWord.ActiveDocument.Close False Next oWord.Quit Set oWord = Nothing ActiveSheet.Columns.AutoFit End Sub 

Answer 1

这将把几个Word文档中的表格导入到Excel中。 顺便说一下，它运行在Excel中…

 Sub GetWordDocContentsFromAllWordDocuments() On Error Resume Next Dim oWord As Object Dim vFiles Dim iFile As Integer Dim R As Range vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True) If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled Set oWord = CreateObject("Word.Application") oWord.Visible = True Set R = Worksheets.Add.Range("A1") For iFile = LBound(vFiles) To UBound(vFiles) oWord.Documents.Open vFiles(iFile) oWord.ActiveDocument.Tables(1).Select oWord.Selection.Copy ActiveSheet.Paste R Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) oWord.ActiveDocument.Close False Next oWord.Quit Set oWord = Nothing ActiveSheet.Columns.AutoFit End Sub Sub GetWordDocContents() Dim oWord As Object Dim vFiles Dim iFile As Integer Dim R As Range vFiles = Application.GetOpenFilename("Word files (*.doc*),*.doc*", Title:="Please select the files you want to copy from", MultiSelect:=True) If TypeName(vFiles) = "Boolean" Then Exit Sub ' Cancelled Set oWord = CreateObject("Word.Application") oWord.Visible = True Set R = Worksheets.Add.Range("A1") For iFile = LBound(vFiles) To UBound(vFiles) oWord.Documents.Open vFiles(iFile) oWord.ActiveDocument.Tables(1).Select oWord.Selection.Copy ActiveSheet.Paste R Set R = Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1) oWord.ActiveDocument.Close False Next oWord.Quit Set oWord = Nothing ActiveSheet.Columns.AutoFit End Sub