VBA for saving multi page dcument with different file names

[wfishero]

I have a multi-page Word Doc that was generated from a software. Every single page in this doc are exactly the same, except for the recipient's name in the "TO:" section at the top. I have created a VBA to programatically save each page one at a time in a pre-designated spot. However, when these pages save, they all save with generic names that I designated in my VBA (i.e. page 1 would save as "Letter 1", page 2 as "Letter 2", and so on). Below is my VBA so far.

Sub BreakOnPage()
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage
For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")

'Select and copy the text to the clipboard.
ActiveDocument.Bookmarks("\page").Range.Copy
' Open new document to paste the content of the clipboard into.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
ChangeFileOpenDirectory "x:\Expirables\JAN\TB"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="Letter_" & DocNum & ".docx"
ActiveDocument.Close
' Move the selection to the next page in the document.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub


This VBA works fantastically! I just wish each page in the doc could have it's own, speacial file name. I have bolded and underlined the section of the VBA that does the Save As function. As you can see, I have it save it as "Letter", and document number.

Is there any way to have the VBA identify a word, that is in the same spot on every page, and use that word as the file name? For example, every page in my word doc has a title - then a few tabs down, it says "TO:", and then a persons name. I would like it to save the file as the persons name.

Any thoughts..?

Thanks,
Wesley

[gmaxey]

This is just a swag because I don't have time to test.

Declare your variables i.e., Dim i as Long

Add two variables:
Dim strName as String
Dim oRng as Range

After DocNum = DocNum + 1 add:

Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "To: "
If .Execute Then
oRng.Collapse wdCollapseEnd
oRng.MoveEndUntil Cset:=Chr(13)
strName = oRng
End If
end With
ActiveDocument.SaveAs FileName:=strName & " " & DocNum & ".docx"

[wfishero]

You'll have to help me out a little more.. Where at in my VBA would I write in those variables you listed, and how do I declare my variables..? I'm very, very new to using macros, so consider me a novice.

Thanks,
W




This is just a swag because I don't have time to test.

Declare your variables i.e., Dim i as Long

Add two variables:
Dim strName as String
Dim oRng as Range

After DocNum = DocNum + 1 add:

Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "To: "
If .Execute Then
oRng.Collapse wdCollapseEnd
oRng.MoveEndUntil Cset:=Chr(13)
strName = oRng
End If
end With
ActiveDocument.SaveAs FileName:=strName & " " & DocNum & ".docx"

[gmaxey]

Open the VBE (ALT+F11), click the Tools menu then Options. On the Editor tab check all the boxes.

When you open a new code window you should see as the first line (and this should be the first line in practically all of your code):

Option Explicit


Variables can be declared at the procedure level, module level, or publicly. In your case you will declare at the procedure level, so after the procedure name:


Sub BreakOnPage()
Dim i as Long
Dim strName as String
Dim oRng as Range
'rest of your code

[wfishero]

Ok, I added in what you said and checked all of the boxes on the Editor tab. When I run it I get an error message saying, "Compile Error: Variable not defined." Obviously I did not delcare the variables right. Here is what I have:


Option Explicit
Sub BreakOnPage()
Dim i As Long
Dim strName As String
Dim oRng As Range
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage
For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")

'Select and copy the text to the clipboard.
ActiveDocument.Bookmarks("\page").Range.Copy
' Open new document to paste the content of the clipboard into.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
ChangeFileOpenDirectory "x:\Expirables\JAN\TB"
DocNum = DocNum + 1
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "To: "
If .Execute Then
oRng.Collapse wdCollapseEnd
oRng.MoveEndUntil Cset:=Chr(13)
strName = oRng
End If
End With
ActiveDocument.SaveAs FileName:=strName & " " & DocNum & ".docx"
ActiveDocument.Close
' Move the selection to the next page in the document.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

[gmaxey]

That is because you have another variable that we missed DocNum. So:

Dim DocNum As Long

BTW when you have an issue like this in the VBE click Debug > Compile project and it will highlight the problem for you.

When you declare variables you should create and stick with a convention that you are comfortable with e.g. I use:

lngSomething for longs
strSomething for strings
bSomething for boolean
oSomething for obects like oRng (range), oShp (shape), oCC (content control) etc.

so personally I would change i to lngIndex

[wfishero]

Ok, it runs and saves the document to what I want it to save it as. Now, I have a new problem - when I run the code, it does not save each page of the document; it saves whatever page my curser is on X number of times. For example - I have a 10 page documents, every page is the same, except the recipient's name at the top in the TO: section. Instead of saving each page of the 10-page doc separately (so I should have 10 different files when I'm done), it saves one page (which ever one my curser is on) 10 times. So in the end I get 10 pages, all for Dr. John Doe. Any thoughts...?

Option Explicit
Sub BreakOnPage()
Dim i As Long
Dim strName As String
Dim oRng As Range
Dim DocNum As Long
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage
For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")

'Select and copy the text to the clipboard.
ActiveDocument.Bookmarks("\page").Range.Copy
' Open new document to paste the content of the clipboard into.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
ChangeFileOpenDirectory "x:\Expirables\JAN\TB"
DocNum = DocNum + 1
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "To: "
If .Execute Then
oRng.Collapse wdCollapseEnd
oRng.MoveEndUntil Cset:=Chr(13)
strName = oRng
End If
End With
ActiveDocument.SaveAs FileName:=strName & " " & DocNum & ".docx"
ActiveDocument.Close
' Move the selection to the next page in the document.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

[gmaxey]

Again, I don't have time to get my head fully into this but it is probably getting confused wrt ActiveDocument

You might try declaring a new variable Dim oDoc as Word.Document then

Set oDoc = Documents.Add
oDoc.Range.Paste etc. etc.

[wfishero]

Where in my code would I input the, "Set oDoc, etc.etc.."?

[gmaxey]

Instead of Documents.Add

Use

Set oDoc = Documents.Add

[wfishero]

Still didn't work, but thank you for helping out. If you think of something else that may work please respond.

Thanks,
W

[gmaxey]

Do you have a name? I don't like going back and forth with someone all day thinking of them as some mutated fish hero.

One reason I have not got my head into this discussion is I don't like you code. Try this variation:


Private Sub SplitByPage()
Dim lngParts As Long
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim oRng1 As Word.Range
Dim bCutoff As Boolean
Dim lngIndex As Long
Application.ScreenUpdating = False

Selection.HomeKey Unit:=wdStory
bCutoff = True
Set oRng = ActiveDocument.Range
lngParts = ActiveDocument.ComputeStatistics(wdStatisticPages)
lngIndex = 1
While lngIndex <= lngParts
If lngIndex = lngParts Then
Selection.GoTo wdGoToPage, wdGoToAbsolute, lngIndex '+ 1
ActiveDocument.Bookmarks("\page").Range.Select
bCutoff = False
Else
Selection.GoTo wdGoToPage, wdGoToAbsolute, lngIndex '+ 1
ActiveDocument.Bookmarks("\page").Range.Select
End If
Selection.Copy
Set oDoc = Documents.Add(ActiveDocument.AttachedTemplate.FullName)
oDoc.Content.Delete 'Strip template boiler plate text
With Selection
.PasteAndFormat (wdFormatOriginalFormatting)
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
If bCutoff Then .Delete Unit:=wdCharacter, Count:=1
End With
Set oRng1 = oDoc.Range
With oRng1.Find
.Text = "To: "
If .Execute Then
oRng1.Collapse wdCollapseEnd
oRng1.MoveEndUntil Cset:=Chr(13)
End If
End With
oDoc.SaveAs FileName:="D:\" & Trim(oRng1.Text)
oDoc.Close wdDoNotSaveChanges
lngIndex = lngIndex + 1
Wend
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True
Set oRng = Nothing
Set oRng1 = Nothing
Set oDoc = Nothing
End Sub