Import multiple Word tables into Excel using VBA - Retaining some original Word formatting

[Engineerlee]

Hi
I am trying to extract and import a number of tables from a word document (this number can vary between documents)
There are normally only 2 columns of information (but on occasion can be more)

I have the following code which will extract and import all the tables into my excel document.
however.
I loose any formatting details from the original word document which I would like to retain
The formatting i would like to retain are carriage returns and bullets.

Any ideas or help would be greatly appreciated

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
Dim resultRow As Long
Dim tableStart As Integer
Dim tableTot As Integer

On Error Resume Next

ActiveSheet.Range("A4:AZ").ClearContents

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
    tableTot = 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 the table to start from", "Import Word Table", "1")
    End If

    resultRow = 4

    For tableStart = 1 To tableTot
        With .tables(tableStart)
            'copy cell contents from Word table cells to Excel cells
            For iRow = 1 To .Rows.Count
                For iCol = 1 To .Columns.Count
                    Cells(resultRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                Next iCol
                resultRow = resultRow + 1
            Next iRow
        End With
        resultRow = resultRow + 1
    Next tableStart
End With

End Sub

 

[Macropod]

See, for example: Help with VBA to extract data from Word to Excel
To preserve bullets, etc., simply insert:
.Range.ListFormat.ConvertNumbersToText
after:
With wdDoc

 

[Engineerlee]

Thank you for your prompt reply.
I have used the micro at present without the update you recommended - To see if the data I get was sufficient - and to make sure I can get your code to work. VBA is still very new to me

the macro starts and I get a message stating that the word file is locked by me for editing.
I am not currently editing the file nor is it open.


Which ever option I pick there appears to be progress then after a few moments the macro stops on the line

WkSht.Paste Destination:=WkSht.Range("A" & r)

on one occasion I didn't receive the popup stating that the file is locked - However it still stopped at the same point on the same line

Not sure if this helps but the word file then appears to be corrupted.
I could open and see content prior to running the VBA, however after word tells me there are 114 pages but I cannot see anything

Any help would be greatly appreciated

 

[Macropod]

A message that says you have the file locked for editing means Windows regards the file is, in fact, open. You could work around that by changing:

Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)

to:

Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)

It would be better, though, to find out why Windows thinks the file is open. The most likely explanation is that you have an orphaned Word session running in the background with the document open. Close Word, then open Task Manager and close any Word instances you see running there.