C
cuppless
Ok usually I would just take my time and try to figure this out on my
own but time is short and I willing admit I am way out of my league.
I found the code on gmayor.com for splitting mail merges. The macro
works to the extent that it will give the first record but then errors
out with Object variable or With block variable not set. Does anyone
see what is obviously wrong here? And a side question is how do I get
these to be saved as .pdf files?
Thanks in advance for any help
Sub SplitMergeLetter()
' splitter Macro modified to save individual letters with
' information from data source. The filename data must be added to
' the top of the merge letter - see web article.
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
.EndKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
sName = Selection
Docname = "F:\Test\" & sName & ".doc"
ActiveDocument.Sections.First.Range.Cut
Documents.Add
With Selection
.Paste
.HomeKey Unit:=wdStory
.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
.Delete
End With
ActiveDocument.SaveAs FileName:=Docname, _
FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Application.ScreenUpdating = True
Wend
End Sub
own but time is short and I willing admit I am way out of my league.
I found the code on gmayor.com for splitting mail merges. The macro
works to the extent that it will give the first record but then errors
out with Object variable or With block variable not set. Does anyone
see what is obviously wrong here? And a side question is how do I get
these to be saved as .pdf files?
Thanks in advance for any help
Sub SplitMergeLetter()
' splitter Macro modified to save individual letters with
' information from data source. The filename data must be added to
' the top of the merge letter - see web article.
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
.EndKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
sName = Selection
Docname = "F:\Test\" & sName & ".doc"
ActiveDocument.Sections.First.Range.Cut
Documents.Add
With Selection
.Paste
.HomeKey Unit:=wdStory
.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
.Delete
End With
ActiveDocument.SaveAs FileName:=Docname, _
FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Application.ScreenUpdating = True
Wend
End Sub