Oct 24, 2014

Import Word Tables into Excel

Sub ImportWordTableIntoExcel()
 Dim wdDoc As Object
 Dim TableNo As Integer 'table number in Word
 Dim nRow As Long 'row index in Excel
 Dim nCol As Long 'row index in Excel
 Dim iRow As Long 'row index in Excel
 Dim iCol As Integer 'column index in Excel
 Dim fileNameArr(0 To 1) As String
 fileNameArr(0) = "C:\Documents\A1.doc"
 fileNameArr(1) = "C:\Documents\A2.doc"
 nRow = 1
 For fileNam = LBound(fileNameArr) To UBound(fileNameArr)
  Set wdDoc = GetObject(fileNameArr(fileNam)) 'open Word file
  With wdDoc
   TableNo = wdDoc.tables.Count
   If TableNo > 2 Then
    With .tables(TableNo - 3)
     'copy cell contents from Word table cells to Excel cells
     For iRow = 1 To .Rows.Count
      nCol = 1
      Cells(nRow, nCol) = fileNameArr(fileNam)
      nCol = nCol + 1
      For iCol = 1 To .Columns.Count
       Cells(nRow, nCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
       nCol = nCol + 1
      Next iCol
      nRow = nRow + 1
     Next iRow
    End With
   End If
  End With
  Set wdDoc = Nothing
 Next fileNam
End Sub

No comments: