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

[RobDog888]

I think this logic may be easier to implement. Its just an example, but try playing with it.

With ActiveDocument.Content.Find
        .ClearFormatting
        .Style = wdStyleNormal
        Do While .Execute(FindText:="%%%", Forward:=True, Format:=True) = True
            With .Parent
                .StartOf Unit:=wdParagraph, Extend:=wdMove
                .Select
                .Cut
                'Paste into new doc ?
                
            End With
        Loop
    End With

[downtown636]

Okay thanks RonDogg, how would I paste the paragraph in a text file at this location e:\billing.txt ?

[RobDog888]

You would need to write the contents of the Windows Clipboard to the file.
Lets search for some code to do that.

Its only text, correct?

Ps, who's RonDogg

[downtown636]

Sorry RobDog888,

Yes it is only text, I just want to cut the red paragraph out of the document and past it in a text file when the macro is executed.

I've been looking for the code to paste it in a text file, would it look something like this:

With ActiveDocument.Content.Find
    .ClearFormatting
    .Style = wdStyleNormal
    Do While .Execute(FindText:="%%%", Forward:=True, Format:=True) = True
        With .Parent
            .StartOf Unit:=wdParagraph, Extend:=wdMove
            .Select
            .Cut
            'Paste into new doc ?
            .Paste FileName:="e:\billing.txt"
        End With
    Loop
End With

Thanks

[RobDog888]

Looks like there is now parameters for the .Paste method. Same for the PasteSpecial,
but not the one we need. This should do the job anyways.

With ActiveDocument.Content.Find
    .ClearFormatting
    .Style = wdStyleNormal
    Do While .Execute(FindText:="%%%", Forward:=True, Format:=True) = True
        With .Parent
            .StartOf Unit:=wdParagraph, Extend:=wdMove
            .Select
            .Cut
            'Paste into new doc ?
            Dim oNewDoc As Word.Document
            Set oNewDoc = Documents.Add
            oNewDoc.Content.Paste
            '.Paste FileName:="e:\billing.txt"
            oNewDoc.SaveAs "E:\Billing.txt", wdFormatText
            oNewDoc.Close False
            Set oNewDoc = Nothing
        End With
    Loop
End With