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
JohnDoe@email.com
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 :wave:

[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 :ehh: ;)

[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 :afrog:

[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