MS Word Macro Help

[downtown636]

Hello everyone,

All I need is the VB code at the bottom rewritten so that it will strip the red paragraph out of the following example document and place it in a text file:

Here is the example document:

John Doe
[email protected]
123-4567
Febuary 8, 2005

Jane Doe
12 Evergreen Rd.
Calgary, AB
S4S 5K9

Dear Jane,

RE: Document example
Mark: 46547
Country: Canada
Serial: 345Abb7
__________________________________

%%%Febuary 8, 2005,”345ABB7”,” TDLR”,Opposition,”preparing correspondence to Jane Doe regarding trademark renewal deadline approaching on March 17, 2005, seeking instructions regarding same”,”46547”,””,””

We note that there is approximately one month remaining within which to effect a timely renewal of the above captioned trademark registration. Should we not file the necessary renewal documents in advance of the March 17, 2005 deadline,


Yours very truly,

FURMAN & KALLIO



John Doe

JD

Sub StripBillingInfo()
On Error GoTo errorhandler
'set up variables
       Dim SectionNumber As Integer
       Dim RangeToSpike As Range
       Dim AccumulatedText As String
'loop through sections
       For SectionNumber = 1 To ActiveDocument.Sections.Count
'mark the first paragraph of the section, less the paragraph mark
           Set RangeToSpike = _
           ActiveDocument.Sections(SectionNumber).Range.Paragraphs.First.Range
           RangeToSpike.MoveEnd wdCharacter, -1
           If RangeToSpike.Start = RangeToSpike.End Then GoTo GetNextSection
           If Mid(RangeToSpike.Text, 1, 3) <> "%%%" Then GoTo GetNextSection
'add the first paragraph to the spike, then delete it
           RangeToSpike.MoveStart wdCharacter, 3
           AccumulatedText = AccumulatedText & RangeToSpike.Text & vbCr
           ActiveDocument.Sections(SectionNumber).Range.Paragraphs.First.Range.Delete
           GetNextSection:
       Next SectionNumber
'create a new document and dump the spike into it
Documents.Open FileName:="e:\billing.txt", ConfirmConversions:=False, Format:=wdOpenFormatText
Selection.EndKey wdStory
          If Selection.Paragraphs.First.Range.Characters.Count > 1 Then
                  Selection.InsertParagraph
                  Selection.EndKey wdStory
          End If
          Selection.TypeText AccumulatedText
          ActiveDocument.Close wdSaveChanges
          errorhandler:
End Sub

Any help is much appreciated