Microsoft Office Forums - View Single Post - [Solved] Macro to remove underscores, except in email address

Guessed · 09-27-2018, 12:41 AM

I would use autoformat to create hyperlinks, then do your search and replace, then restore the email displayed text based on the hyperlinks. The code would look like this...

Code:

Sub Macro1()
  Dim aHL As Hyperlink
  With Options
    .AutoFormatApplyHeadings = False
    .AutoFormatApplyLists = False
    .AutoFormatApplyBulletedLists = False
    .AutoFormatApplyOtherParas = False
    .AutoFormatReplaceQuotes = False
    .AutoFormatReplaceSymbols = False
    .AutoFormatReplaceOrdinals = False
    .AutoFormatReplaceFractions = False
    .AutoFormatReplacePlainTextEmphasis = False
    .AutoFormatReplaceHyperlinks = True
    .AutoFormatPreserveStyles = True
    .AutoFormatPlainTextWordMail = True
    .LabelSmartTags = False
  End With
  ActiveDocument.Range.AutoFormat

  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "_"
    .Replacement.Text = " "
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
  End With
  For Each aHL In ActiveDocument.Range.Hyperlinks
    If aHL.Type = msoHyperlinkRange Then
      aHL.TextToDisplay = Replace(aHL.Address, "mailto:", "")
    End If
  Next aHL
End Sub