Access vba to edit header in word (1 Viewer)

sxschech

Registered User.
Local time
Today, 02:27
Joined
Mar 2, 2010
Messages
791
A typo was discovered in a word document that we receive. Was advised that they are not going to provide a corrected version to users until there is a major change to the file. Since via Access, I have been able to edit text elsewhere in the word doc, I thought would be simple enough to add a bit more code to my existing function to handle fixing the typo. I was able to locate the text and can view it in the immediate window, so I know it is finding the header data. I first tried
Code:
worddoc.sections(1).headers(2).Range.Text=Replace(worddoc.sections(1).headers(2).Range.Text, "Elecricfication", "Electrification")

This didn't correct the typo, instead it obliterated the formatting, removed graphics and changed colour of text from Black to Blue.

I then tried the version further below and it tells me (via stepping through and using ? in the immediate window) that nothing is found.

Code:
? worddoc.sections(1).headers(2).range.text
/
THIS IS FOR
EXAMPLE Purposes 
Electricfication Data Services
Contract No.: 58-CTR-Q-091
/


I can isolate the text in question in the immediate window as such:
--NOTE, I changed the wording of the above since didn't want to display
actual text, so the mid function numbers will be off.--

Code:
? mid(worddoc.sections(1).headers(2).Range.Text,46,18)
 
Electricfication

Code:
With WordApp
        With WordDoc.sections(1).headers(2).Range.Find
            .Text = "Elecricfication"
            .Replacement.Text = "Electrification"
            .MatchWholeWord = True
            'Replaces all occurences
            '.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
            'Replaces one occurence
            '.Execute Replace:=wdReplaceOne, Forward:=True, Wrap:=wdFindStop
            .Execute Replace:=1, Forward:=True, Wrap:=0
        End With
    End With

What might I be missing? Thanks.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:27
Joined
Oct 29, 2018
Messages
21,357
Hi. Sorry I can't help with the code (I am not familiar with Word VBA) but was just curious why it's necessary to use Access to do this correction. Why can't it be done manually, one time? Just wondering...
 

sxschech

Registered User.
Local time
Today, 02:27
Joined
Mar 2, 2010
Messages
791
If it were only one time, sure I could manually edit. These are files that are sent from several departments anywhere from one to several a day. Since I already have automation set up, I had hoped to simply add a bit more code to the existing function that inserts data not available to the requester and does error checking on it. For example, they have used the most current version, they put the proper date range and ticked the proper check boxes etc.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:27
Joined
Oct 29, 2018
Messages
21,357
If it were only one time, sure I could manually edit. These are files that are sent from several departments anywhere from one to several a day. Since I already have automation set up, I had hoped to simply add a bit more code to the existing function that inserts data not available to the requester and does error checking on it. For example, they have used the most current version, they put the proper date range and ticked the proper check boxes etc.
Hi. Thanks for the explanation. Good luck!
 

Micron

AWF VIP
Local time
Today, 05:27
Joined
Oct 20, 2018
Messages
3,476
I can't see anything wrong but then I'm not a Word automation expert. It would have been better if there was enough code to verify that declarations and references are accurate. I have been able to do this with a slightly different syntax:
Code:
sections(1).Headers(wdHeaderFooterPrimary).Range.Text
but I suspect that's not your issue. If you were able to modify the text but screwed up the formatting, then my guess would be by not explicitly dealing with that formatting in your code you have applied defaults when you didn't want to.
 

sxschech

Registered User.
Local time
Today, 02:27
Joined
Mar 2, 2010
Messages
791
Thanks all. I had seen Gasman's suggestion in my initial search and after a quick look, moved on as at that point was trying to locate one that was specific to the header. I took a second look at it and decided to make a go of it. Had to make a few modifications to have it work in Access. I am putting two versions here. First one is the original code modified for Access and second one is getting passed the data from the function that has all my other code because the document is already opened and I know what value to pass it. Since the Sub SearchAndReplaceInStory works for both, am only showing it once at the very bottom.

Code uses late binding, so should not need to set a reference.

Stand Alone. Could further modify it to provide the find and replace text on the Public Sub line rather than having it prompt for the values.
Code:
Public Sub FindReplaceAnywhereOrig(sfile As String)
'Modified and added Orig to sub name so that can use this
'as standalone when needed and adjusted code so that will
'work from MS-Access.
'Suggested by GasMan Post#6
'https://www.access-programmers.co.uk/forums/showthread.php?t=307233
'20191008
'https://wordmvp.com/FAQs/Customization/ReplaceAnywhere.htm
'20191008
    Dim WordApp               As Object
    Dim worddoc               As Object
    Dim bAppAlreadyOpen       As Boolean
    Dim rngStory As Object
    Dim pFindTxt As String
    Dim pReplaceTxt As String
    Dim lngJunk As Long
    Dim oShp As Shape
  
    bAppAlreadyOpen = True
    'Get an instance of word to work with
    'See if Word is already running
    On Error Resume Next
    Set WordApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        'Launch a new instance of Word
        Err.Clear
        'On Error GoTo Error_Handler
        Set WordApp = CreateObject("Word.Application")
        bAppAlreadyOpen = False
    End If
  
    Set worddoc = WordApp.Documents.Open(sfile)
    worddoc.ActiveWindow.View.ReadingLayout = False
    WordApp.Application.Visible = True
  
    pFindTxt = InputBox("Enter the text that you want to find." _
                        , "FIND")
    If pFindTxt = "" Then
        MsgBox "Cancelled by User"
        Exit Sub
    End If
TryAgain:
    pReplaceTxt = InputBox("Enter the replacement.", "REPLACE")
    If pReplaceTxt = "" Then
        If MsgBox("Do you just want to delete the found text?", _
                    vbYesNoCancel) = vbNo Then
            GoTo TryAgain
        ElseIf vbCancel Then
            MsgBox "Cancelled by User."
            Exit Sub
        End If
    End If
    'Fix the skipped blank Header/Footer problem
    lngJunk = worddoc.Sections(1).Headers(1).Range.storytype
    'Iterate through all story types in the current document
    For Each rngStory In worddoc.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
                            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

Dependent version.
This version assumes being called from code that has already opened a word file. Use this line to call it. (change the words to find and replace as needed)
Code:
FindReplaceAnywhere worddoc, "Electricfication", "Electrification"

Code:
Public Sub FindReplaceAnywhere(worddoc As Object, pFindTxt As String, pReplaceTxt As String)
'This version relies on word and the docx file already being open and is called from another sub/function
'Originally wanted to only edit the header, however since this code searches all, leaving
'as is for now.  Story Range Header StoryType is 10.
'MODIFIED FROM FindRpleaceAnywhereOrig --Actually the name of the Original did not have ORIG
'https://wordmvp.com/FAQs/Customization/ReplaceAnywhere.htm
'Suggested by GasMan Post#6
'https://www.access-programmers.co.uk/forums/showthread.php?t=307233
'20191008
    Dim rngStory As Object
    Dim lngJunk As Long
    Dim oShp As Shape
    
    'Fix the skipped blank Header/Footer problem
    lngJunk = worddoc.Sections(1).Headers(1).Range.storytype
    'Iterate through all story types in the current document
    For Each rngStory In worddoc.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
                        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

Code:
Public Sub SearchAndReplaceInStory(ByVal rngStory As Object, ByVal strSearch As String, ByVal strReplace As String)
'https://wordmvp.com/FAQs/Customization/ReplaceAnywhere.htm
'21091008
    With rngStory.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = strSearch
        .Replacement.Text = strReplace
        .Wrap = 0 'wdFindContinue
        .Execute Replace:=1 'wdReplaceAll
    End With
End Sub
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:27
Joined
Oct 29, 2018
Messages
21,357
Hi. Thanks for the update. Glad to hear you got it sorted out. Good luck with your project.
 

sxschech

Registered User.
Local time
Today, 02:27
Joined
Mar 2, 2010
Messages
791
Thanks theDBguy. Appreciate your encouragement.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 02:27
Joined
Oct 29, 2018
Messages
21,357
Thanks theDBguy. Appreciate your encouragement.
Hi. You're very welcome. It's the least I can do since I couldn't help you with the Word VBA problem. Cheers!


PS. Actually, I might be the one thanking you later on if I have to use this stuff since you already did the work for me. So, thanks!
 

Users who are viewing this thread

Top Bottom