G
Greg
Here is a macro that saves each page of a file as a new
file in the root c:\ directory. The file name is the
content of the first paragraph.
Doug Robbins - I hope you see this thread. I pulled the
basic macro off of google from a discussion you had with
Rashid Khan about four months ago. I was having the
errors saving the file as well. The problem turned out to
be that Word was attempting to save a file name with a
paragraph mark in it. Once I backed the range off one
character it worked great.
Sub SaveEachPageOfCurrentDocumentAsANewDocument()
Dim pCounter As Long
Dim pNumPages As Long
Dim pParent As Document
Dim pChild As Document
Dim pParentName As String
Dim pChildName As String
Dim pChildNameRange As Range
If ActiveDocument.Saved = False Then
Documents.Save NoPrompt:=False, _
OriginalFormat:=wdOriginalDocumentFormat
End If
Set pParent = ActiveDocument
pParentName = pParent.FullName
Selection.HomeKey Unit:=wdStory
pNumPages = pParent.BuiltInDocumentProperties
(wdPropertyPages)
pCounter = 0
While pCounter < pNumPages
pCounter = pCounter + 1
pParent.Bookmarks("\Page").Range.Cut
Set pChild = Documents.Add
pChild.Range.Paste
Set pChildNameRange = pChild.Range
pChildNameRange.Collapse wdCollapseStart '
pChildNameRange.Expand Unit:=wdParagraph
pChildNameRange.MoveEnd Unit:=wdCharacter, Count:=-1
pChildName = pChildNameRange
pChild.SaveAs FileName:="C:\\" & pChildName & ".doc"
pChild.Close
Wend
pParent.Close SaveChanges:=wdDoNotSaveChanges
Documents.Open pParentName
End Sub
file in the root c:\ directory. The file name is the
content of the first paragraph.
Doug Robbins - I hope you see this thread. I pulled the
basic macro off of google from a discussion you had with
Rashid Khan about four months ago. I was having the
errors saving the file as well. The problem turned out to
be that Word was attempting to save a file name with a
paragraph mark in it. Once I backed the range off one
character it worked great.
Sub SaveEachPageOfCurrentDocumentAsANewDocument()
Dim pCounter As Long
Dim pNumPages As Long
Dim pParent As Document
Dim pChild As Document
Dim pParentName As String
Dim pChildName As String
Dim pChildNameRange As Range
If ActiveDocument.Saved = False Then
Documents.Save NoPrompt:=False, _
OriginalFormat:=wdOriginalDocumentFormat
End If
Set pParent = ActiveDocument
pParentName = pParent.FullName
Selection.HomeKey Unit:=wdStory
pNumPages = pParent.BuiltInDocumentProperties
(wdPropertyPages)
pCounter = 0
While pCounter < pNumPages
pCounter = pCounter + 1
pParent.Bookmarks("\Page").Range.Cut
Set pChild = Documents.Add
pChild.Range.Paste
Set pChildNameRange = pChild.Range
pChildNameRange.Collapse wdCollapseStart '
pChildNameRange.Expand Unit:=wdParagraph
pChildNameRange.MoveEnd Unit:=wdCharacter, Count:=-1
pChildName = pChildNameRange
pChild.SaveAs FileName:="C:\\" & pChildName & ".doc"
pChild.Close
Wend
pParent.Close SaveChanges:=wdDoNotSaveChanges
Documents.Open pParentName
End Sub