Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Repeating Microsoft Word VBA until no search results found

Tags:

ms-word

vba

I've created a MS Word macro that searches for certain text (indicated by markup codes), cuts the text and inserts it into a new footnote, and then deletes the markup codes from the footnote. Now I want the macro to repeat until it doesn't find any more markup codes in the text.
Here's the macro below

Sub SearchFN()

'find a footnote
Selection.Find.ClearFormatting
With Selection.Find
    .Text = "&&FB:*&&FE"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
End With
Selection.Find.Execute

'cut the footnote from the text
Selection.Cut

'create a proper Word footnote
With Selection
    With .FootnoteOptions
        .Location = wdBottomOfPage
        .NumberingRule = wdRestartContinuous
        .StartingNumber = 1
        .NumberStyle = wdNoteNumberStyleArabic
    End With
    .Footnotes.Add Range:=Selection.Range, Reference:=""
End With

'now paste the text into the footnote
Selection.Paste

'go to the beginning of the newly created footnote
'and find/delete the code for the start of the note (&&FB:)
    Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "&&FB:"
    .Replacement.Text = ""
    .Forward = False
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
End With
Selection.Find.Execute
With Selection
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseStart
    Else
        .Collapse Direction:=wdCollapseEnd
    End If
    .Find.Execute Replace:=wdReplaceOne
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseEnd
    Else
        .Collapse Direction:=wdCollapseStart
    End If
    .Find.Execute
End With

'do same for ending code (&&FE)
With Selection.Find
    .Text = "&&FE"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchFuzzy = False
    .MatchWildcards = True
End With
Selection.Find.Execute
With Selection
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseStart
    Else
        .Collapse Direction:=wdCollapseEnd
    End If
    .Find.Execute Replace:=wdReplaceOne
    If .Find.Forward = True Then
        .Collapse Direction:=wdCollapseEnd
    Else
        .Collapse Direction:=wdCollapseStart
    End If
    .Find.Execute
End With

Selection.HomeKey Unit:=wdStory
'now repeat--but how??    

End Sub
like image 273
OutThere Avatar asked Nov 20 '12 02:11

OutThere


People also ask

How do I make a Macro run automatically in Word?

To do this, follow these steps: Select the Developer tab, and then select Record Macro in the Code group. In the Record Macro dialog box, type Auto-Exec under Macro name, and then select OK. By default, the macro is saved in the Normal template.


1 Answers

Good question this one, you can loop through the whole document using the Selection.Find.Found result.

What you do is start a search and if you find a result go into a loop only while the Selection.Find.Found result is true. Once you've got through these, you're done. The following code should do the trick nicely for you.

Sub SearchFN()
    Dim iCount As Integer

    'Always start at the top of the document
    Selection.HomeKey Unit:=wdStory

    'find a footnote to kick it off
    With Selection.Find
        .ClearFormatting
        .Text = "&&FB:*&&FE"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
        .Execute
    End With

    'If we find one then we can set off a loop to keep checking
    'I always put a counter in to avoid endless loops for one reason or another
    Do While Selection.Find.Found = True And iCount < 1000
        iCount = iCount + 1

        'Jump back to the start of the document.  Since you remove the
        'footnote place holder this won't pick up old results
        Selection.HomeKey Unit:=wdStory
        Selection.Find.Execute

        'On the last loop you'll not find a result so check here
        If Selection.Find.Found Then

            ''==================================
            '' Do your footnote magic here
            ''==================================

            'Reset the find parameters
            With Selection.Find
                .ClearFormatting
                .Text = "&&FB:*&&FE"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchKashida = False
                .MatchDiacritics = False
                .MatchAlefHamza = False
                .MatchControl = False
                .MatchByte = False
                .MatchAllWordForms = False
                .MatchSoundsLike = False
                .MatchFuzzy = False
                .MatchWildcards = True
            End With
        End If
    Loop
End Sub
like image 146
CuberChase Avatar answered Sep 24 '22 16:09

CuberChase