CODEWITHSUNDEEP
vbams-word
Mac
Mac

Reputation: 1

Why is my VBA macro only splitting the 1st and 3rd parts of a Word document?

I have a macro which takes one Word document, copies the data inside my parameters then pastes it multiple separate documents (in this case three).

This is the first time using VBA, so please go easy.

The original document is a long document, which has multiple repeating sections. By filling in the original document, the user can save time completing one rather than three near identical documents. I have split the original into three sections. My code takes the data from the first declared section and pastes it into a new document. It also works for the third. The second, however does not work.

The

With R.Find
.Text = "START OF FORM*^12"
.MatchWildcards = True

section looks for the text 'Start of Form' and takes that and the rest of the contents up until '^12' (which I believe refers to a page break).

The document is set out so that each section of the document starts with that text and finishes with page break.

Sub DocSplit()

' Declares variable (in this case R).
Dim R As Range

' Sets R to the active document, being a number of ranges (will be defined later).
Set R = ActiveDocument.Range.Duplicate

'  You won't be able to see what the macro is doing, but will run quicker.
Application.ScreenUpdating = False

' For R, find text with whatever is in the " marks.
With R.Find
.Text = "START OF FORM*^12"
.MatchWildcards = True

' Runs a series of statements as long as given conditions are true. While it's doing this,
While .Execute

' Copy and saves contents of R.
CopyAndSave R

' While ends.
Wend

'With ends.
End With

' Collapses range to the ending point.
R.Collapse wdCollapseEnd

' Returns or sets the ending character position of a range.
R.End = R.Parent.Range.End
CopyAndSave R

End Sub
Static Sub CopyAndSave(R As Range)

' Declares D as document.
Dim D As Document

' Represents the number of words in the collection.
' Long is a datatype for values too large for "integer".
Dim Count As Long
Count = Count + 1

' Copies R from previous Sub to a new document.
R.Copy
Set D = Documents.Add

' Pastes range, preserving original formatting.
D.Range.PasteAndFormat wdFormatOriginalFormatting


D.SaveAs R.Parent.Path & Application.PathSeparator & _
"F00" & Count, wdFormatDocument
D.Close

End Sub

I did expect three documents, F001, F002 and F003 to be created. I get two files, one containing the first section (as intended) and one file containing the last two.

Upvotes: 0

Views: 71

Answers (1)

Louis
Louis

Reputation: 3632

I took a quick look at your code and I found these errors:

  • If you want the counter to increment each time the function is called, you must declare it in the main function, otherwise it will lose memory each time it's called.
  • R.Find needs an argument. If you want more details, look at here
  • R.End needs an argument, here you'll find some hints, depending on what you need to do.

I've updated some parts of your code to help you: 

Sub DocSplit()

    ' Declares variable (in this case R).
    Dim R As Range

    ' Represents the number of words in the collection.
    ' Long is a datatype for values too large for "integer".
    Dim count As Long
    count = 0

    ' Sets R to the active document, being a number of ranges (will be defined later).
    Set R = ActiveDocument.Range.Duplicate

    '  You won't be able to see what the macro is doing, but will run quicker.
    Application.ScreenUpdating = False

    ' For R, find text with whatever is in the " marks.
    With R.Find("Text your're searching")
        .Text = "START OF FORM*^12"
        .MatchWildcards = True

        ' Runs a series of statements as long as given conditions are true. While it's doing this,
        While .Execute

            ' Copy and saves contents of R.
            Call CopyAndSave(R, count)

        ' While ends.
        Wend

    'With ends.
    End With

    ' Collapses range to the ending point.
    R.Collapse wdCollapseEnd

    ' Returns or sets the ending character position of a range.
    R.End = R.Parent.Range.End
    Call CopyAndSave(R)

End Sub
Static Sub CopyAndSave(R As Range, count As Long)
    ' Declares D as document.
    Dim D As Document

    count = count + 1

    ' Copies R from previous Sub to a new document.
    R.Copy
    Set D = Documents.Add

    ' Pastes range, preserving original formatting.
    D.Range.PasteAndFormat wdFormatOriginalFormatting


    D.SaveAs R.Parent.Path & Application.PathSeparator & _
    "F00" & count, wdFormatDocument
    D.Close

End Sub

If you have any doubts, don't hesitate to ask.

Upvotes: 0

Related Questions