I did some playing with your sample doc. I don't think we're going to be able to use the Table of Contents bookmarks. (Probably someone else with a lot more experience in Word VBA could, but I don't think I'm going to get there!) Word has a lot of hidden bookmarks. The TOC bookmarks are hidden, and you can't access them by code unless you know the secret password:
vb Code:
ActiveDocument.Bookmarks.ShowHidden = True
Once that vat is open, though, there's a ton of stuff! Now you have to sift and sort through all the hidden bookmarks by name and range and anything else you can think of. Because your search text is goin to be found in several of them - I don't know why. And going to the place in the document for that specific bookmark is also difficult.
So I changed the code to search for your chapter/subchapter text and verify the style. The code searches from the end of the document for the text in the Config file, so it bypasses the TOC altogether. The only hiccup during test was that your Heading 2 style overflowed into your body text at one point, so it caught the caption text in the body paragraph instead of the header. And it doesn't treat tables very well - but that can all be smoothed out as they decide what they want to do with the data.
So here's the updated code. I do have several Stop points in there to allow you to see what's going on. Very useful for me since I have two monitors and I can put the code on one and the test doc on the other!
Code:
Sub GetMyStuff()
'*******************
'Object declarations
'
'To declare Word objects, set a reference
'to the Word object library.
'Tools >> References >> Microsoft Word
'
'(Since both Word and Excel have range objects,
'but they have different Methods and Properties,
'we must specifically declare as Word or Excel
'range to avoid confusion.)
'*******************
'Set Excel objects
Dim XLwkb1 As Workbook 'This workbook
Dim XLwkb2 As Workbook 'Workbook for data
Dim XLwks1 As Worksheet 'Worksheet with config
Dim XLwks2 As Worksheet 'Worksheet to hold data
Dim XLrngC1 As Excel.Range 'Individual cell in config wksht
Dim XLrngC2 As Excel.Range 'Individual cell in data wksht
Dim XLrngW1 As Excel.Range 'Range of cells in wks1
Dim XLrngW2 As Excel.Range 'Range of cells in wks2
'Set Word objects
Dim appWD As Word.Application
Dim WDdoc As Document 'Report document
Dim WDrngCh As Word.Range 'Range for one complete chapter
Dim WDrngHdr1 As Word.Range 'Range for one chapter header
Dim WDrngHdr2 As Word.Range 'Range for next chapter header
'Other objects
Dim strRptP As String 'Complete path for report
Dim strRptN As String 'Doc name for report
Dim strChp1 As String 'Title of chapter to grab
Dim strChp2 As String 'Title of next chapter
Dim strStyle As String 'Name of text style
Dim lastRow As Long 'Last row to search in config book
Dim numRow As Long 'Used for row number in data wkb
Dim arrName 'Used to extract doc name from path
Dim valAutoSec 'Word AutomationSecurity setting
'*******************
'Main routine
'*******************
'Set initial Excel objects
Set XLwkb1 = ActiveWorkbook
Set XLwks1 = XLwkb1.Worksheets("Sheet1")
'Find and open your Word doc
Set appWD = New Word.Application
'Turn off macros
On Error Resume Next
valAutoSec = appWD.AutomationSecurity
appWD.AutomationSecurity = msoAutomationSecurityForceDisable
On Error GoTo 0
strRptP = Application.GetOpenFilename
If strRptP <> "" Or _
strRptP = "False" Then
Set WDdoc = appWD.Documents.Open(strRptP)
appWD.Visible = True
'Get name of report
strRptN = WDdoc.Name
'Remove doc type from name
arrName = Split(strRptN, ".")
strRptN = arrName(0)
Else
MsgBox "No file selected"
GoTo CleanUp
End If
'Create new workbook for search results
Set XLwkb2 = Workbooks.Add
Set XLwks2 = XLwkb2.Worksheets("Sheet1")
'Format first column
With XLwks2.Range("A:A")
.WrapText = True
.ColumnWidth = 65
End With
'Stop screen flashing
'Comment out or remove if you want to observe it working while testing
'Application.ScreenUpdating = False
'appWD.ScreenUpdating = False
'Find your X
'Get the last row of config requirements
lastRow = XLwks1.Range("A10000").End(xlUp).Row
'Iterate through cells in Col B to find the X
For Each XLrngC1 In XLwks1.Range("B2:B" & lastRow)
'********
'For checking code
Debug.Print XLrngC1.Row
Stop
'********
If XLrngC1.Value = "x" Or XLrngC1.Value = "X" Then 'Big X or small x in cell
strChp1 = XLrngC1.Offset(0, -1) 'Get text in cell on same row, one column back
strChp2 = XLrngC1.Offset(1, -1) 'Get text from one row down, one column back
Set WDrngCh = WDdoc.Content.Duplicate
'Find chapter name
pointGetChp1: 'Set a return point
WDrngCh.Find.Execute Findtext:=strChp1, Forward:=False, MatchCase:=True, Wrap:=wdFindStop
If WDrngCh Is Nothing Then
MsgBox strChp1 & " not found in this document."
GoTo CleanUp
End If
'********
'For checking code
WDrngCh.Select
Stop
'********
'GoTo CleanUp
'Check for Style
strStyle = WDrngCh.Style
Stop
'GoTo CleanUp
If InStr(1, strStyle, "Heading 2") = 0 Then _
GoTo pointGetChp1 'Go back and try again
'GoTo CleanUp
'Set range to chapter heading
Set WDrngHdr1 = WDrngCh.Duplicate
'********
'For checking code
WDrngHdr1.Select
Stop
'********
'Reset the search range
' Set WDrngCh = WDdoc.Content.Duplicate
WDrngCh.SetRange WDrngHdr1.End, WDdoc.Content.End
'If the last chapter heading on the config worksheet is X'd, then strChp2 is blank.
'We'll skip the next Find and just grab the remaining text
If strChp2 <> "" Then
'Repeat Find to get next chapter name
pointGetChp2: 'Set a return point
WDrngCh.Find.Execute Findtext:=strChp2, Forward:=False, MatchCase:=True, Wrap:=wdFindStop
If WDrngCh Is Nothing Then
MsgBox strChp2 & " not found in this document."
GoTo CleanUp
End If
'********
'For checking code
WDrngCh.Select
Stop
'********
'GoTo CleanUp
'Check for Style
strStyle = WDrngCh.Style
Stop
'GoTo CleanUp
If InStr(1, strStyle, "Heading 2") = 0 Then _
GoTo pointGetChp2 'Go back and try again
'Set range to chapter heading
Set WDrngHdr2 = WDrngCh.Duplicate
'********
'For checking code
WDrngHdr2.Select
Stop
'********
'Get the text in between
WDrngCh.SetRange _
Start:=WDrngHdr1.End, _
End:=WDrngHdr2.Start
Else
Stop
WDrngCh.SetRange _
Start:=WDrngHdr1.End, _
End:=WDdoc.Content.End
End If
'********
'For checking code
WDrngCh.Select
Stop
'********
'Set our text into new workbook, Sheet1
'Find the first empty cell in Column A and add 2
numRow = XLwks2.Range("A10000").End(xlUp).Row + 2
'Put chapter heading in first cell
XLwks2.Range("A" & numRow).Value = WDrngHdr1.Text
'Skip a cell and copy chapter text
WDrngCh.Copy
XLwks2.Range("A" & numRow + 2).PasteSpecial xlPasteValues
'If you stop here and look at the pasted-in results,
'Excel has put each paragraph in one cell.
'Not sure what it will do with tables, graphics, etc.
'This completes the grab for one doc
'Lather, rinse, repeat until finished
End If
Next XLrngC1
CleanUp:
'Screen updating on
Application.ScreenUpdating = True
appWD.ScreenUpdating = True
appWD.AutomationSecurity = valAutoSec
'Save and close the Excel file
'If you have a designated folder, add it into the Filename
XLwkb2.SaveAs Filename:=WDdoc.Path & "\" & strRptN
XLwkb2.Close
'Close the report doc
WDdoc.Close wdDoNotSaveChanges
appWD.DisplayAlerts = wdAlertsNone
appWD.Quit 'Closes and quits Word
Set appWD = Nothing 'Releases the Word object
appWD.DisplayAlerts = wdAlertsAll
End Sub
Reply With Quote
using the Thread Tools menu ...
but unfortunately progress is slowing and I'm coming up against a brick wall as I don't really have much experience in vba 
I'm trying to, once selected, go directly to that bookmark, then set the range from that bookmark to the next, then I can copy that range....thank you so much for helping me so far, it really has been appreciated. 
