Excel VBA code to get Word document data

[jilualx]

Hi,
I am trying this from long. I need a help from all experts out there.
I have a word document with contents and tables. I am able to get the table numbers and also able to extract the data in table. But I want to get the heading of the table also which is the line above each table.
Is there any way to understand the line number of the table and get the data in the line above?
I want to do all these from Excel.
Please help.Hi,
I am trying this from long. I need a help from all experts out there.
I have a word document with contents and tables. I am able to get the table numbers and also able to extract the data in table. But I want to get the heading of the table also which is the line above each table.
Is there any way to understand the line number of the table and get the data in the line above?
I want to do all these from Excel.
Please help.

 

[mole999]

post the code you have tried

 

[jilualx]

Sub ImportWordTables()




Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer
Dim iTable As Integer
Dim iRow As Long
Dim iCol As Integer


wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _
"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

 

[anvg]

Hi

I want to get the heading of the table also which is the line above each table.

If you have not any empty paragraph between a heading and a table you can try with a such function

Public Function GetHeadingText(ByVal wdDoc As Object, ByVal TableNum As Long) As String
    Dim firstCharNum As Long
    firstCharNum = wdDoc.Tables(TableNum).Range.Characters(1).Start
    GetHeadingText = wdDoc.Characters(firstCharNum - 2).Paragraphs(1).Range.Text
End Function

Regards,

 

[jilualx]

Thanks Anvg!!!

It worked. You are brilliant.

I need one more help. If you could please.

In word table to move one selected row down we could use
Selection.Range.Relocate wdRelocateDown

And, to move it up we could use
Selection.Range.Relocate wdRelocateUp

Is there any alternative for this to be used from excel. I tried using the same from excel its not working.

Regards,

 

[jilualx]

Please Help

 

[anvg]

Is there any alternative for this to be used from excel

Yes

Public Sub RelocateUp(ByVal RowId As Long)
    ActiveSheet.Cells(RowId, 1).EntireRow.Cut
    ActiveSheet.Cells(RowId - 1, 1).EntireRow.Insert Shift:=xlDown
End Sub

Public Sub RelocateDown(ByVal RowId As Long)
    ActiveSheet.Cells(RowId, 1).EntireRow.Cut
    ActiveSheet.Cells(RowId + 2, 1).EntireRow.Insert Shift:=xlDown
End Sub

Regards,