Deleting bad line breaks and arrows from copied e-mail text

[Larry]

Mr. B,

Here's my all-purpose macro that I use for this job. It removes the bad
line breaks as well as removing any arrows and adjusting the remaining
spaces around them, plus a bunch of other functions which I can't
explain right now. Just install this macro and the accompanying
function in your VB editor (write back if you need instructions on
installing a macro), assign a keystroke or menu button to the macro, and
it will do it all for you in one step.

A couple of the comments may be confusing, but I've had this macro
around for a long time now, with various modifications to it being added
from time to time, and I haven't had to time to make it look perfectly
clean. However, it's in good working shape.

Larry


Sub ArrowsAndLineBreaksDelete()
' by Larry

Application.ScreenUpdating = False

' Look for .\!\? or .\!\?" followed by line break and replace by same
followed by
' two line breaks. For e-mails with no double line breaks between
paras.
' Without adding extra line break, deleting the single linebreak makes
' whole document one paragraph.

Dim r As Range, r1 As Range
Set r = Selection.Range

Call DoArrowBreak("> ", "")
Call DoArrowBreak(">", "")

Selection.Find.ClearFormatting
With Selection.Find
.Text = "[.:\?\!""]^l^l[A-Za-z]"
.Replacement.Text = "^~-"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
If .Found = False Then GoTo AddBreaks
End With


' Searches long lines with no punctuation followed by two or more
' line breaks. If no such lines exist, the text does not need to have
' multiple line breaks reduced to single line break. Thus, if there is
at least
' one proper para break, and if there is no long line broken in the
middle of a sentence (this If...Then statement),
' then only the main code runs.

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l[!^l\.\?\!""-:]{54,}^l{2,}"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute
If .Found = False Then GoTo Maincode
End With


' changing multiple line breaks to one to
' handle text with all lines separated by two line breaks
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^l{2,}"
.Replacement.Text = "^l"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

AddBreaks:
' Now begins work of adding 2nd line break to true paras.

' looks for sentence end followed by line break
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([.\!\?])^l"
.Replacement.Text = "\1^l^l"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

' looks for sentence end followed by any size space followed by line
break
With Selection.Find
.Text = "([.\!\?]) {1,}^l"
.Replacement.Text = "\1^l^l"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

' looks for line break immediately following sentence end followed by
quote
With Selection.Find
.Text = "([.\!\?])("")^l"
.Replacement.Text = "\1\2^l^l"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

' looks for sentence end with quote followed by any size space followed
by line break
With Selection.Find
.Text = "([.\!\?])("") {1,}^l"
.Replacement.Text = "\1\2^l^l"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

' jump over add2nd linebreak
Maincode:

Call DoArrowBreak("^l^l", "^p^p")
Call DoArrowBreak("^l", " ")

' clean out empty space or spaces at beginning of some lines
With Selection.Find
.Text = "^13 {1,}"
.Replacement.Text = "^p"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Reduces two or more interword spaces to one throughout document

Set r1 = Selection.Range
Selection.HomeKey wdStory

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([a-z\A-Z\0-9\,\;])( {2,})([a-z\A-Z\0-9\""\'])"
.Replacement.Text = "\1 \3"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

' This looks for quotes not following sentence punctuation
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([!.\?\!][""\'])( {2,})([a-z\A-Z\0-9\""\'])"
.Replacement.Text = "\1 \3"
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

r1.Select

' change single hyphens surrounded by space to double nonbreaking
hyphens
Call DoArrowBreak(" - ", "^~-")

' Reduce three or more para marks to two.
With Selection.Find
.Text = "^13{3,}"
.Replacement.Text = "^p^p"
.MatchWildcards = True
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

'clear find
With Selection.Find
..Text = ""
..Replacement.Text = ""
..MatchWildcards = False
End With

r.Select

' Dismiss selection if there is one
If Selection.Type = wdSelectionNormal Then Selection.Collapse
wdCollapseStart

End sub

Function DoArrowBreak(findText As String, ReplaceText As String)

' Works with ArrowsAndLineBreaksDelete macro

Selection.Find.MatchWildcards = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = findText
.Replacement.Text = ReplaceText
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Function




'-----------------

 

[Larry]

This macro also has an additional feature that handles e-mail which lack
an empty line between paragraphs. The macro looks for places where a
sentence end occurs at the end of a line (based on the assumption that
in most cases that will be the end of a pargraph as well), and inserts
an extra paragraph return at those points. This is not perfect, as a
few extra pargraph returns may be created. But this code is only run if
the original text lacks empty lines between paragraphs, so it can't do
any harm.

Larry