Looping and selecting active document

Question

What I need to do is take a paragraph copy and paste it into a new file, save that file and then have it automatically do the same for the next paragraph. The code I have does this once. However, my document is 250 pages long with over 300 paragrpahs so I need this to automatically loop. Here is my code so far:

Sub clicktest()
    '
    ' clicktest Macro
    '
    '

    Selection.MoveDown Unit:=wdParagraph, Count:=34, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
    Selection.Copy
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=37
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdFormatOriginalFormatting)

    Dim PathAndFileName As String, n As Long

    PathAndFileName = "\\r04brxnas20\VHABRXOSTROR$\Trace"
    If Dir(PathAndFileName & ".txt") = "" Then
        ActiveDocument.SaveAs (PathAndFileName & ".txt"), FileFormat:=wdFormatText
    Else
        n = 1
        Do While Dir(PathAndFileName & n & ".txt") <> ""
            n = n + 1
        Loop
        ActiveDocument.SaveAs PathAndFileName & n & ".txt"
    End If
End Sub

The problem I'm having is to loop this and have the active document be the original so it selects the right paragraph automatically.

What's it doing now that is different from what you want it to do? — eddie_cat, Aug 04 '14 at 18:33
@eddie_cat from OP: *The code I have does this once. However, my document is 250 pages long with over 300 paragrpahs so I need this to automatically loop*. — David Zemens, Aug 04 '14 at 19:20

score 1 · Answer 1 · edited May 23 '17 at 11:49

A simple loop over the Paragraphs collection should probably work.

Also, since it seems you are only concerned with creating plain text output files, there's no need to Copy or Paste anything and in fact there's no need to even use a new Document, all of this can be done with standard I/O statements.

Here is that approach, I have also tidied up the file naming convent & loop which had an error when I tried it.

Sub copyparagraphs2()
Dim pg As Paragraph
Dim doc As Document
Dim ff As Integer
Dim Path As String, n As Long
Dim filename As String

Path = "\\r04brxnas20\VHABRXOSTROR$\Trace\"

Set doc = ActiveDocument

'# Loop over the PARAGRAPHS in this document
For Each pg In doc.Paragraphs

    '# Construct a file path that doesn't already exist:
    Do While Not Dir(Path & n & ".txt") = ""
        n = n + 1
    Loop

    '# specify the filename
    filename = n & ".txt"

    '# Create the text file
    CreateObject("Scripting.FileSystemObject").CreateTextFile (Path & filename)

    '# print the text to the text file
    ff = FreeFile
    Open Path & filename For Output As #ff
    Print #ff, pg.Range.Text
    Close ff

Next
End Sub

This avoids the need to worry about which Document is Active or Selection entirely.

Here is a related read on why to avoid Select/Activate whenever possible. It is written for Excel, where the Selection object is much easier to avoid using than it is in Word, but the same general principles apply.

How to avoid using Select in Excel VBA macros

Looping and selecting active document

1 Answers1