PDA

View Full Version : Help finding Table after text in Word Document



Blakearino
07-08-2015, 09:34 AM
I have some experience with VBA. But I am having troublefiguring out how to capture the following information from Word documents to Excel. These documents are test scripts with requirements for screen prints. My goal is to capture the test script number information and then locate the nexttable and copy the step numbers that call for screen prints. So the worksheet would look like.

A

B

C



TestScript01

Step#

Attachment# (1)



TestScript01

Step #

Attachment # (2)



TestScript02

Step #

Attachment # (1-…)



I can already extract the step numbers from the table to excel using the table object (see code). I can also get the test script numbers by stepping through the paragraph object.
What I need help with is searching for (Test Script X),adding it to column A and then locating the next table to search for screenprint steps, then also continue to search for the next Test Script andfollowing table, all the way to the end.



Word doc

Blah, blah, blah
Test Script 01


Table with test steps












Test Script 02


Table with test steps













Test Script 03


Table with test steps












Blah, blah, blah

I have tried variations of .para.Range.GoTo wdGoToTable,wdGoToNext, 1with no success.
Thanks in advance for any help getting going in the rightdirection.

Blake


Sub ImportAttachmentStepNumbers()
'Imports stepnumbers where a screen print is required in table from Word document. Thisskips the first x tables to get the first Test Script table.
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'number of tables in Word doc
Dim iTable As Integer 'table number index
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim tabnum AsInteger ‘Table number
Dim strt As Integer ‘Excel row to start at
wdFileName =Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _
"Browse forfile 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
.ConvertNumbersToText 'freezes numbering of test steps
TableNo =wdDoc.tables.Count
If TableNo = 0Then
MsgBox "This document contains notables", _
vbExclamation, "Import Word Table"
ElseIf TableNo> 1 Then
TableNo1 =InputBox("This Word document contains " & TableNo & "tables." & vbCrLf & _
"Entertable number of table to begin importing from ", "Import WordTable", "1")
End If
strt = 4 'Excel row to start with
Last = TableNo- 2 'Last two tables will error
For tabnum =TableNo1 To Last
With.tables(tabnum)
Cells(strt,1) = "Table " & tabnum
strt = strt +1
colcnt =.Columns.Count
If colcnt< 2 Then GoTo skip ‘Check for at least two columns
'copy cellcontents from Word table cells to Excel cells
att = 1 ‘Attachment number
For iRow = 2To .Rows.Count
'For iCol= 1 To .Columns.Count
If.cell(iRow, 2).Range.Text Like "*screen print*" Then
Cells(strt,2) = WorksheetFunction.Clean(.cell(iRow, 1).Range.Text)
Cells(strt,3) = att
strt = strt+ 1
att = att+ 1
End If
' Next iCol
Next iRow
strt = strt + 1
End With
skip:
Next tabnum
End With
Set wdDoc = Nothing
End Sub

And

Sub Find_Test_Script_numbers()
'Imports Test Script Numbers from Word document by searching Paragraphs

Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'number of tables in Word doc
Dim iTable As Integer 'table number index
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim jj As Integer
Dim veek 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
.ConvertNumbersToText
veek = 4 'Excel row to start with
For Each para In .Paragraphs
If para.Range.Text Like "*Test Script Number:*" Then
‘Selection = para.Range
Cells(veek, 1) = WorksheetFunction.Clean(para.Range.Text)
veek = veek + 1
Next iRow
veek = veek + 1
End With
fluffy:
End If
Next para
End With
Set wdDoc = Nothing
End Sub