View Single Post
 
Old 07-25-2025, 10:11 PM
Hornblower409's Avatar
Hornblower409 Hornblower409 is offline Windows 10 Office 2010
Competent Performer
 
Join Date: Jan 2025
Posts: 136
Hornblower409 will become famous soon enoughHornblower409 will become famous soon enough
Default

An alternative using Word Find/Replace

Code:
Public Sub ReplaceInSelection()

    Word_ReplaceInSelection "Find This", "Replace With This"
    
End Sub

Private Function Word_ReplaceInSelection(ByVal FindTxt As String, ByVal ReplaceText As String) As Boolean
Word_ReplaceInSelection = False

    '   Must have an Active Inspector
    '
    If Not (TypeOf ActiveWindow Is Outlook.Inspector) Then
        MsgBox "The Active Window must be an Inspector.", vbExclamation
        Exit Function
    End If
    
    '   Get the Active Inspector Word Doc
    '
    Dim wDoc As Word.Document
    Set wDoc = ActiveInspector.WordEditor
            
    '   Word Doc must be editable
    '
    If wDoc Is Nothing Then
        MsgBox "Active Inspector has no Word Editor.", vbExclamation
        Exit Function
    End If
    
    If wDoc.ProtectionType <> wdNoProtection Then
        MsgBox "Active Inspector is Locked For Editing (Read Only).", vbExclamation
        Exit Function
    End If
    
    '   Word Doc must have a Selection
    '
    Dim wDocSelection As Word.Selection
    Set wDocSelection = wDoc.Application.Selection
    If wDocSelection Is Nothing Then
        MsgBox "Active Inspector Selection is Nothing.", vbExclamation
        Exit Function
    End If
    If wDocSelection.Start = wDocSelection.End Then
        MsgBox "Active Inspector Selection is empty.", vbExclamation
        Exit Function
    End If
    
    '   Replace all occurances
    '
    Dim wDocSearch As Word.Range
    Set wDocSearch = Word_FindDefault(wDocSelection.Range.Duplicate)
    wDocSearch.Find.Text = FindTxt
    wDocSearch.Find.Replacement.Text = ReplaceText
    wDocSearch.Find.Execute Replace:=wdReplaceAll

Word_ReplaceInSelection = True
End Function

'   Reset a Word .Find object to defaults
'
'   From https://gregmaxey.com/word_tip_pages/words_fickle_vba_find_property.html
'
Private Function Word_FindDefault(ByVal wRange As Word.Range) As Word.Range

    Set Word_FindDefault = wRange
    With Word_FindDefault.Find
    
        .ClearFormatting
        .Format = False
        .Forward = True
        .Highlight = wdUndefined
        .IgnorePunct = False
        .IgnoreSpace = False
        .MatchAllWordForms = False
        .MatchCase = False
        .MatchPhrase = False
        .MatchPrefix = False
        .MatchSoundsLike = False
        .MatchSuffix = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .Text = ""
        .Wrap = wdFindStop

    End With
    
End Function
Reply With Quote