Headers

BrotherDude · #1 07-13-2015, 12:11 PM

Hello,

I am trying to loop through all the headers in a document searching for a text string. If that string is found I would like to select it and the connected text to the left and pass the text value to a string variable so I can split and name the documents by these string values.

I know this is a few parts but if you can help with any of the modules it would be much appreciated.

1. Loop through all headers
2 Search for text string, select entire word, save value to string
3. Export Page and name by string variable

Any help is much appreciated. I found several sources for search and replace but the structure, ranges and object naming seems more complicated than necessary. I can provide some code that has yielded some results but seems off track.

-Jeff

Code:

Public Sub FindReplaceAnywhere()
    Dim rngStory As Word.Range
    Dim pFindTxt As String
    Dim pReplaceTxt As String
    Dim lngJunk As Long
    Dim oShp As Shape
 
     pFindTxt = "-IN"
     'pReplaceTxt = "-IN**"  'From Sorce Code
 
 
    'Fix the skipped blank Header/Footer problem
    lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
 
    'Iterate through all story types in the current document
    For Each rngStory In ActiveDocument.StoryRanges
 
        'Iterate through all linked stories
        Do
            SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
            On Error Resume Next
            Select Case rngStory.StoryType
                Case 6, 7, 8, 9, 10, 11
                    If rngStory.ShapeRange.Count > 0 Then
                        For Each oShp In rngStory.ShapeRange
                            If oShp.TextFrame.HasText Then
                                SearchAndReplaceInStory oShp.TextFrame.TextRange, pFindTxt, pReplaceTxt
                                'FindIt oShp.TextFrame.TextRange, pFindTxt, pReplaceTxt
                            End If
                        Next
                    End If
                Case Else
                    'Do Nothing
                End Select
                On Error GoTo 0
 
                'Get next linked story (if any)
                Set rngStory = rngStory.NextStoryRange
            Loop Until rngStory Is Nothing
        Next
End Sub
 
 
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, ByVal strSearch As String, ByVal strReplace As String)
Dim Invoice As String
Dim rngInvoice As Range
Dim strStart As Long
Dim strEnd As Variant
 
'Best I could do, Prints the range of the area I want. Seems like I should be using .moveleft ?
With rngStory
    If .Find.Execute(strSearch) Then Debug.Print .Start - 7 & " " & .End
End With
 
End Sub

I found this which seems like it should be used to select the range but I'm struggling to name the header range and actually select the text I want

Code:

With Selection 
 Set MyRange = .GoTo(wdGoToField, wdGoToPrevious) 
 .MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend 
 If Selection.Fields.Count = 1 Then Selection.Fields(1).Update 
End With

IDK pretty lost when it comes to Word and VBA. Any help is muchh appreciated!!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Microsoft Word macro to find text, select all text between brackets, and delete	helal1990	Word VBA	4	02-05-2015 03:52 PM
Macro for find/replace (including headers and footers) for multiple documents	jpb103	Word VBA	2	05-16-2014 04:59 AM
How to find and select text in a document?	mkhuebner	Word VBA	8	02-04-2014 08:04 PM
Nested vlookup with varable tables!	Dave Jones	Excel	0	08-30-2012 09:15 AM
Unable to Select Multiple folders in Outlook 2007 Advance Find	gregory	Outlook	2	04-28-2012 10:53 PM