Importing Word Table with bullets into Excel range

[gravanoc]

Sorry for the double-post, but I used the wrong title in my last post.
A table like this exists in a Word document:

Currently, the code I'm using to import the table's data will put the data with more than one value (under Toll Booths and Toll) into the same cell. I don't want to copy and paste the table, and I don't need to preserve the bullets. I just need to put the separate values in separate cells.

Code (omits calling sub):

Sub WordInterop(ByVal wksMain As Worksheet, ByRef strFolder As String)

Dim fso As FileSystemObject
Dim aFold As Folder
Dim aFile As File
Dim wordApp As Word.Application
Dim wordFile As Word.Document
Dim wordTable As Word.Table
Dim wordTableCell As Word.Cell
Dim rngImport As Excel.Range
  
Dim i As Long, rowNoOutput As Long
Dim rowNo As Long, colNo As Long
Dim headersCount As Long
Dim strImport As String, tblHeaders As String
  
Set wordApp = New Word.Application
Set rngImport = wksMain.Range("A1")
Set fso = New FileSystemObject
Set aFold = fso.GetFolder(strFolder)
  
rowNoOutput = 1
headersCount = 0
tblHeaders = "City Section Toll Booths Toll"
wordApp.Visible = False
  
For Each aFile In aFold.Files
  
If (Not InStr(1, aFile, "~") > 0 And InStr(1, aFile.Name, ".doc") > 0) Then
Set wordFile = wordApp.Documents.Open(aFold.Path & Application.PathSeparator & aFile.Name)
For i = 0 To wordFile.Tables.Count - 1
              
With wordFile.Tables(i + 1)
For rowNo = 0 To .Rows.Count - 1
For colNo = 0 To .Columns.Count - 1
strImport = WorksheetFunction.Clean( _
.Cell(rowNo + 1, colNo + 1).Range.Text)

 

[NdNoviceHlp]

gravanoc the png of your table didn't post so it's not clear what the issue is? Are there 2 values in 1 table cell that U want to separate OR are 2 table cells combining to make 1 output? Anyways, U will need to post the rest of your code (at least until the end of the file loop) to provide for an understanding of what is going on. I really don't understand why you are starting with table 0 and row 0 and column 0 and then re-adjusting them all to 1? There is no table 0, row 0 or column 0. Maybe abit more info is needed. HTH. Dave

 

[gravanoc]

@NdNoviceHlp I didn't realize my code got cut off in the middle, my apologies. I'll repost it here with more explanation and a new picture.

Hopefully this picture shows. The problem I'm having is getting the data in the Toll Booths and Toll cells to separate into separate Excel cells.
I'm thinking there must be some subordinate object within the table's that I can access, or that I'll have to manipulate the string by looking for a certain
whitespace character and splitting that into separate cells. At least, that's the next thing I plan to try. As for starting at 0 with those objects, it's just a habit of mine,
I could start them at 1 as well without using the + 1. Thanks!

So in this example:

City	Section	Toll Booths	Toll
Chicago	Northwest	Osborne Connector	DAYTIME:
		Reynolds Pkwy	$1.50​
		Station-Clairborne	$1.70​
			$2.10​
			AFTERNOON-EVENING
			$2.20​
			$3.00​
			$4.50​
Next Table Import Begins...

Code:

Sub WordInterop(ByVal wksMain As Worksheet, ByRef strFolder As String)

    Dim fso As FileSystemObject
    Dim aFold As Folder
    Dim aFile As File
    Dim wordApp As Word.Application
    Dim wordFile As Word.Document
    Dim wordTable As Word.Table
    Dim wordTableCell As Word.Cell
    Dim rngImport As Excel.Range
    
    Dim i As Long, rowNoOutput As Long
    Dim rowNo As Long, colNo As Long
    Dim headersCount As Long
    Dim strImport As String, tblHeaders As String
    
    Set wordApp = New Word.Application
    Set rngImport = wksMain.Range("A1")
    Set fso = New FileSystemObject
    Set aFold = fso.GetFolder(strFolder)
    
    rowNoOutput = 1
    headersCount = 0
    tblHeaders = "City Section Toll Booths Toll"
    wordApp.Visible = False
    
    For Each aFile In aFold.Files
    
        If (Not InStr(1, aFile, "~") > 0 And InStr(1, aFile.Name, ".doc") > 0) Then
            Set wordFile = wordApp.Documents.Open(aFold.Path & Application.PathSeparator & aFile.Name)
            For i = 0 To wordFile.Tables.Count - 1
                
                With wordFile.Tables(i + 1)
                    For rowNo = 0 To .Rows.Count - 1
                        For colNo = 0 To .Columns.Count - 1
                            strImport = .Cell(rowNo + 1, colNo + 1).Range.Text
                            strImport = WorksheetFunction.Clean( _
                                .Cell(rowNo + 1, colNo + 1).Range.Text)
                            If InStr(1, tblHeaders, strImport) > 0 Then
                                headersCount = headersCount + 1
                                If headersCount > 5 Then GoTo SkipLoop
                            End If
                            
                            rngImport.Cells(rowNoOutput + 1, colNo + 1) _
                                .Value = strImport
SkipLoop:
                        Next colNo
                        If rngImport.Cells(rowNoOutput + 1, 1) <> "" Then _
                            rowNoOutput = rowNoOutput + 1
                    Next rowNo
                End With ' wordFile.Tables
                
            Next i
            
            wordFile.Close
        End If
    Next aFile
    
    Set wordApp = Nothing

End Sub

 

[NdNoviceHlp]

I see that does look difficult. The table cells for "TollBooths" & "Toll" have multiple lines that you want separated. I think those lines maybe separated by a CHR(13) so you can trial something like this untested code...

Dim SplitCell As Variant, cnt As Integer
rowNoOutput = 2
For i = 0 To wordFile.Tables.Count - 1
With wordFile.Tables(i + 1)
For RowNo = 0 To .Rows.Count - 1
For colNo = 0 To .Columns.Count - 1
strImport = .Cell(RowNo + 1, colNo + 1).Range.Text
If InStr(1, tblHeaders, strImport) > 0 Then
headersCount = headersCount + 1
If headersCount > 5 Then GoTo SkipLoop
End If
'****************
If (colNo + 1 = 3) Or (colNo + 1 = 4) Then
SplitCell = Split(strImport, Chr(13))
For cnt = LBound(SplitCell) To UBound(SplitCell) - 1
rngImport.Cells(rowNoOutput + cnt, colNo + 1).Value = SplitCell(cnt)
rowNoOutput = rowNoOutput + 1
Next cnt
'****************
Else
strImport = WorksheetFunction.Clean(.Cell(RowNo + 1, colNo + 1).Range.Text)
rngImport.Cells(rowNoOutput, colNo + 1).Value = strImport
rowNoOutput = rowNoOutput + 1
End If
SkipLoop:
Next colNo

If rngImport.Cells(rowNoOutput + 1, 1) <> "" Then _
    rowNoOutput = rowNoOutput + 1
Next RowNo
End With ' wordFile.Tables

The general idea is to use the split function to separate the contents of the relevant cells. Not sure when I'll be able to take a further look at this. If you still have no success, I'll dummy up a document for testing. Good luck. HTH. Dave

 

[gravanoc]

I see that does look difficult. The table cells for "TollBooths" & "Toll" have multiple lines that you want separated. I think those lines maybe separated by a CHR(13) so you can trial something like this untested code...

Dim SplitCell As Variant, cnt As Integer
rowNoOutput = 2
For i = 0 To wordFile.Tables.Count - 1
With wordFile.Tables(i + 1)
For RowNo = 0 To .Rows.Count - 1
For colNo = 0 To .Columns.Count - 1
strImport = .Cell(RowNo + 1, colNo + 1).Range.Text
If InStr(1, tblHeaders, strImport) > 0 Then
headersCount = headersCount + 1
If headersCount > 5 Then GoTo SkipLoop
End If
'****************
If (colNo + 1 = 3) Or (colNo + 1 = 4) Then
SplitCell = Split(strImport, Chr(13))
For cnt = LBound(SplitCell) To UBound(SplitCell) - 1
rngImport.Cells(rowNoOutput + cnt, colNo + 1).Value = SplitCell(cnt)
rowNoOutput = rowNoOutput + 1
Next cnt
'****************
Else
strImport = WorksheetFunction.Clean(.Cell(RowNo + 1, colNo + 1).Range.Text)
rngImport.Cells(rowNoOutput, colNo + 1).Value = strImport
rowNoOutput = rowNoOutput + 1
End If
SkipLoop:
Next colNo

If rngImport.Cells(rowNoOutput + 1, 1) <> "" Then _
    rowNoOutput = rowNoOutput + 1
Next RowNo
End With ' wordFile.Tables

The general idea is to use the split function to separate the contents of the relevant cells. Not sure when I'll be able to take a further look at this. If you still have no success, I'll dummy up a document for testing. Good luck. HTH. Dave

Thanks Dave. I will take a look at this now and let you know.