2016-07-24 122 views
0

我有一个包含大约300个单页文档的文件夹。每个文档包含大约3个表格和一些文本。例如,在每个文档中都有一个表名为“stackoverflow”的表。如何在多个word文档中找到某个表格并将其提取到一个excel表格中

这里是我的Word文档示例的图像:
enter image description here

我有很多像这样的文件,但都不同,除了一个事实,即他们都有一个表中的“计算器”它(如图片中所示)。

我想要做的是从这些表中将所有文档中的所有名称从所有文档中提取到一个Excel表单中。

我试了一下到目前为止,这是一段代码:

Sub ImportWordTable() 
    Dim wdDoc As Object 
    Dim wdFileName As Variant 
    Dim TableNo As Integer 'table number in Word 
    Dim iRow As Long 'row index in Excel 
    Dim iCol As Integer 'column index in Excel 

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ 
    "Browse for file containing table to be imported") 

    If wdFileName = False Then Exit Sub '(user cancelled import file browser) 
     Set wdDoc = GetObject(wdFileName) 'open Word file 

     With wdDoc 
      TableNo = wdDoc.tables.Count 
      If TableNo = 0 Then 
       MsgBox "This document contains no tables", _ 
       vbExclamation, "Import Word Table" 
      ElseIf TableNo > 1 Then 
       TableNo = InputBox("This Word document contains " & TableNo & "  tables." & vbCrLf & _ 
       "Enter table number of table to import", "Import Word Table", "1") 
      End If 
      With .tables(TableNo) 
       'copy cell contents from Word table cells to Excel cells 
       For iRow = 1 To .Rows.Count 
        For iCol = 1 To .Columns.Count 
         Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text) 
        Next iCol 
       Next iRow 
      End With 
     End With 
     Set wdDoc = Nothing 
    End Sub 

随着这段代码我可以选择我想提取到Excel的表,它完美的作品,除了一个事实,即我有自己输入表格编号,它只适用于一个文档。

我也发现了这一段代码,选择具有一定的字符串里面的表:

Sub Find_Text_in_table() 
    Selection.Find.ClearFormatting 
    With Selection.Find 
     .Text = "donec" 
     .Replacement.Text = "" 
     .Forward = True 
     .Wrap = wdFindAsk 
     .Format = False 
     .MatchCase = False 
     .MatchWholeWord = False 
     .MatchWildcards = False 
     .MatchSoundsLike = False 
     .MatchAllWordForms = False 
    End With 

    Do While Selection.Find.Execute 
     If Selection.Information(wdWithInTable) Then 
      Stop 
      'now you are in table with text you searched 
      'be careful with changing Selection Object 
      'do what you need here 
     End If 
    Loop 
End Sub 

但我不知道如何将这些2

+0

@ShaiRado这是我发现/尝试的 – Gromdroid

+0

表中的文本“表2:StackOverflow”实际上是在表中,还是在表格上方的某种标题? –

+0

它有点棘手,在一些表格中,我认为它是表格的一部分,在其他表格中是其上面的标题。我确实发现,表格中有一个标题,里面有'name'和'adres',否则'table 2:Stackoverflow'在表格中,表格中没有'name'或'adres'。 – Gromdroid

回答

0

结合我有一个类似的问题我想我有你的解决方案。 你将以下代码

If TableNo = 0 Then 
    MsgBox "This document contains no tables", _ 
    vbExclamation, "Import Word Table" 
ElseIf TableNo > 1 Then 
    TableNo = InputBox("This Word document contains " & TableNo & "  tables." & vbCrLf & _ 
    "Enter table number of table to import", "Import Word Table", "1") 
End If 

这此代码,而不是

Dim myRow As Row 
    Dim myCell As Cell 
    Dim TargetTable As Long 

    For x = 1 To wdDoc.ActiveDocument.Tables.Count 
     For Each myRow In wdDoc.ActiveDocument.Tables(x).Rows 
      For Each myCell In myRow.Cells 
       If InStr(1, myCell.Range.Text, "stackoverflow", vbTextCompare) > 0 And _ 
        TargetTable <> 0 Then MsgBox "More than one table matches description" & _ 
             "Table #" & TargetTable & " and table #" & x 
       If InStr(1, myCell.Range.Text, "stackoverflow", vbTextCompare) > 0 Then TargetTable = x 
      Next 
     Next 
    Next x 
    TableNo = TargetTable 

什么我的代码所做的是循环遍历每个表的每一行的每个单元,并记录表索引如果搜索文本找到。如果找到多于一个的比赛,它会发出警告,但会使用找到的最后一场比赛。

+0

我得到以下错误:“对象不支持此属性或方法”在这条线:“对于x = 1到wdDoc.ActiveDocument.Tables.Count” – Gromdroid

+0

与 更换 wdDoc.ActiveDocument.Tables wdDoc。表 – Shodan

+0

该脚本现在正在工作,但我发现我认为它不可能搜索'stackoverflow',因为它有时在表中,有时不是。你知道是否有可能只搜索“名字”?因为我尝试过,但现在它还发现“businessname” – Gromdroid

0

第一个问题,打开多个文件:你想Application.FileDialog(),如: https://msdn.microsoft.com/en-us/library/office/ff840210.aspx 我碰巧在Publisher中使用它,但同样适用于这里:

Sub InsertAndSizeWinners() 

    Dim fd As FileDialog  ' File picker, to select images to insert. 
    Dim nm As Variant   ' File name strings selected to insert. 

    ' Create a FileDialog object as a File Picker dialog box. 
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 

    fd.Title = "Select documents" 

    If fd.Show = -1 Then  ' 0 = Cancel, -1 = OK, got list. 
     For Each nm In fd.SelectedItems ' List of fully qualified file names. 
      ProcessFilename nm ' Process each c:\dir\path\file_name.jpg. 
     Next nm 
     MsgBox "All done. You can start arranging now." 
    End If 
    ' Else, user hit Cancel on file selection dialog box. Simply end. 

End Sub 

这是一个非常简单的循环获取您指定的列表,然后调用子例程(ProcessFilename)分别处理每个子例程。

相关问题