#1
|
|||
|
|||
Macro to remove underscores, except in email address
Hi,
I'm trying to replace all underscores in a word document with a single space, except for underscores in email addresses. Could someone please help? I've got the following already: Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "_" .Replacement.Text = " " .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll This will replace all underscores. I don't know how to ignore email addresses... Thanks in advance! |
#2
|
||||
|
||||
Are your email addresses formatted as hyperlinks?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Hi Macropod,
Unfortunately the e-mail addresses are not formatted as hyperlinks. The Word document is the result of merging fields, and apparently this doesn't automatically format the e-mail addresses... |
#4
|
||||
|
||||
In that case maybe
Code:
Sub Macro1() Dim oRng As Range Dim oWord As Range Set oRng = ActiveDocument.Range With oRng.Find Do While .Execute(FindText:="_") Set oWord = oRng.Duplicate If oWord.Words(1).Start <> ActiveDocument.Range.Start Then oWord.MoveStartUntil Chr(32), wdBackward oWord.MoveEndUntil Chr(32) & Chr(13) If InStr(1, oWord.Text, "@") = 0 Then oRng.Text = " " End If oRng.Collapse 0 Loop End With lbl_Exit: Set oRng = Nothing Set oWord = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
||||
|
||||
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#6
|
||||
|
||||
Quote:
Code:
Sub Demo() Application.ScreenUpdating = False Dim Hlnk As Hyperlink With ActiveDocument With .Range 'Activate email addresses as hyperinks With .Find .ClearFormatting .Replacement.ClearFormatting .Forward = True .Format = False .Wrap = wdFindStop .MatchWildcards = True .Text = "<[0-9A-?.\-_]{1,}\@[0-9A-?\-_]{1,}.[a-z]{2,3}>" .Replacement.Text = "" .Execute End With Do While .Find.Found i = i + 1 .Hyperlinks.Add Anchor:=.Duplicate, Address:="mailto:" & .Text, TextToDisplay:=.Text .Start = .Hyperlinks(1).Range.End .Find.Execute Loop 'Replace underscores with spaces With .Find .Text = "_" .Replacement.Text = " " .Wrap = wdFindContinue .MatchWildcards = False .Execute Replace:=wdReplaceAll End With End With 'Repair email address underscores For Each Hlnk In .Hyperlinks With Hlnk If InStr(.Address, "mailto:") > 0 Then .TextToDisplay = Split(.Address, "mailto:")(1) End With Next End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Hi everyone, thanks for the replies.
Gmayor's code seems to do the trick... If I'm having problems with this solution later on, I can always try the other suggestions. Thanks! |
Tags |
macro replace email |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Hide Email Address of Previous Email when Replying or Forwarding | bondingfortoday | Outlook | 0 | 03-05-2016 04:29 PM |
Add link to email address that hides the actual address or makes it inaccessible to online bots | richiebabes | Word | 1 | 09-03-2014 03:22 PM |
Macro to send from non-default email address | k.n. | Mail Merge | 5 | 12-03-2013 03:22 AM |
Mail Merge Many URLs in one email by common email address | instantaphex | Mail Merge | 3 | 04-29-2013 05:46 PM |
Remove a Group Email address from Outlook | meppwc | Outlook | 0 | 10-17-2012 07:09 AM |