Search code examples
vbams-wordword-2016

Word 2016 VBA: can't find EndOfDoc when cursor is in footnote


I made a search-&-replace macro that loops to the end of the document, like so:

Sub CheckEnglishAndTypos()
    Do Until ActiveDocument.Bookmarks("\Sel").Range.End = ActiveDocument.Bookmarks("\EndOfDoc").Range.End
    'Loop the search till the end
        Selection.MoveDown Unit:=wdLine, Count:=1
        Selection.Paragraphs(1).Range.Select
        With Selection.Find
            .Text = "(<*>) \1"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
            Selection.Find.Execute Replace:=wdReplaceAll
        Loop
        ' Searching the remaning (till the end of document)
        Exit Sub
End Sub

Problem is, if the document has any footnote, and the search move into the footnote, it will then give a "Requested Member of the Collection Does Not Exist" error. Apparently, the macro can't find the end of the document if the selection/cursor is inside a footnote, and the document has pages following the page the footnote's at.

Is there anyway to fix it? A way to exclude the footnotes from search would be cool, but I'm open to any other alternative solutions.


Solution

  • the search string is the issue

    Sub CheckEnglishAndTypos()
    
        Options.DefaultHighlightColorIndex = wdBlue
    '   Options.DefaultHighlightColorIndex = wdYellow
    
        With ActiveDocument.Content.Find
            .ClearFormatting
    '       .Text = "(<*>) \1"                ' really slow
            .Text = " ([A-Za-z]@) \1"
            .Replacement.Text = ""
            .Replacement.ClearFormatting
            .Replacement.Highlight = True
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchWildcards = True
            .Execute Replace:=wdReplaceAll
        End With
    End Sub