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

  • Thread starter Thread starter Larry
  • Start date Start date
L

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




'-----------------
 
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
 
Back
Top