Extract a range of tables from word document based on page number

user_18956080 0
Viewed 43

My Word document has 50 tables in it and it consists of approx 100 pages ,

  1. I need to know how can i extract the tables based on page number/range, for example, extract tables from page 48 - page 56 . Currently the code i am using Thanks to Macropod it is extracting based on table index in the word document . From the end-user point of view it will be tedious to find the table index and enter it in the Popup MessageBox.

  2. How can we use the file path as an input from the user. Either they are able input the filename or file path in the following variable

"Set wdDoc = .Documents.Open(ActiveWorkbook.Path & "\fivetables.docx")"

Code currently using -

Sub ImportWordTables()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim xlWkSht As Worksheet, i As Long, j As Long, t As Long
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Open(ActiveWorkbook.Path & "\fivetables.docx")
  With wdDoc
    t = .Tables.Count
    i = CLng(InputBox("The document has " & t & " tables." & vbCr & _
        "Table to start at?"))
    If i < 1 Then GoTo ErrExit
    If i > t Then GoTo ErrExit
    j = CLng(InputBox("The document has " & t & " tables." & vbCr & _
        "Table to end at?"))
    If j > t Then j = t
    For t = i To j
      .Tables(t).Range.Copy
      Set xlWkSht = ActiveWorkbook.Worksheets.Add
      xlWkSht.PasteSpecial "HTML"
      xlWkSht.Range("A1").CurrentRegion.EntireColumn.AutoFit
    Next
ErrExit:
    .Close False
  End With
  .Quit
End With
Application.ScreenUpdating = True
End Sub
ms-word vba excel
1 Answers

For example:

Sub ImportWordTables()
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim wdRng As Word.Range, wdTbl As Word.Table
Dim xlWkSht As Worksheet, i As Long, j As Long, p As Long
With wdApp
  .Visible = False
  Set wdDoc = .Documents.Open(FileName:=ActiveWorkbook.Path & "\fivetables.docx", AddToRecentFiles:=False)
  With wdDoc
    p = .ComputeStatistics(wdStatisticPages)
    i = CLng(InputBox("The document has " & p & " pages." & vbCr & _
        "Page to start at?"))
    If i < 1 Then GoTo ErrExit
    If i > p Then GoTo ErrExit
    j = CLng(InputBox("The document has " & p & " pages." & vbCr & _
        "Page to end at?"))
    If j > p Then j = p
    Set wdRng = .Range.GoTo(What:=wdGoToPage, Name:=i).GoTo(What:=wdGoToBookmark, Name:="\page")
    wdRng.End = .Range.GoTo(What:=wdGoToPage, Name:=j).GoTo(What:=wdGoToBookmark, Name:="\page").End
    For Each wdTbl In wdRng.Tables
      wdTbl.Range.Copy
      Set xlWkSht = ActiveWorkbook.Worksheets.Add
      xlWkSht.PasteSpecial "HTML"
      xlWkSht.Range("A1").CurrentRegion.EntireColumn.AutoFit
    Next
ErrExit:
    .Close False
  End With
  .Quit
End With
Application.ScreenUpdating = True
End Sub
user_91702740
Related