Mail Merge Document Splitter Works! Kind of...

[TheSQLWasBet]

Hello all!

I'm a little new to VBA, but I'm trying to write something that will save a document for each employee in my Excel sheet. I want the document to have the employee's name, and I want each document to be saved in a folder with their supervisors name.

After I run my macro, I have two correct employee-named documents in the correct supervisor-named folders, but when you open one of the documents, you see that the document doesn't match the name. For example, I have



Employee
Supervisor
Mergefield


Bart Simpson
Bruce Wayne
Stuff


Tilda Swinton
Danny DeVito
Things



"Bart Simpson" is in a folder marked "Bruce Wayne" and "Tilda Swinton" is in the "Danny DeVito" folder, but the document marked "Tilda Swinton" still says "Bart Simpson"

Here's what I have:


Sub DocSplitter()
'
' Macro3 Macro
'




Dim rec, lastRecord As Integer
Dim docNameField, strDocName, strDefpath, strDirname, savePath As String


Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
lastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord


For rec = ActiveDocument.MailMerge.DataSource.firstRecord To lastRecord


ActiveDocument.MailMerge.DataSource.ActiveRecord = rec


strDocName = ActiveDocument.MailMerge.DataSource.DataFields("LastName").Value & ", " & ActiveDocument.MailMerge.DataSource.DataFields("FirstName").Value & ".pdf"
strDefpath = Application.ActiveDocument.Path
strDirname = ActiveDocument.MailMerge.DataSource.DataFields("Supervisor").Value


With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.Execute
End With




If Len(Dir(strDefpath & "\" & strDirname, vbDirectory)) = 0 Then


MkDir (strDefpath & "\" & strDirname)


End If


savePath = strDefpath & "\" & strDirname & "\" & strDocName


ActiveDocument.ExportAsFixedFormat OutputFileName:=savePath, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close False


ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord


Next rec

Application.ScreenUpdating = True
Application.DisplayAlerts = True



End Sub


Does anyone see where I went wrong?

[macropod]

Instead of reinventing the wheel, see Send Mailmerge Output to Individual Files in the Mailmerge Tips and Tricks thread at:
http://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html
or:
http://windowssecrets.com/forums/showthread.php/163017-Word-Mailmerge-Tips-amp-Tricks

That said, there's nothing apparent in your code that would account for what you've described.

[TheSQLWasBet]

Thank you!

Turns out the problem was with how I was counting my records. I was able to fix the problem by using "...".DataSource.RecordCount instead of lastRecord

Here is the solution:


Sub DocSplitter()
'
'
'




Dim rec, lastRecord As Integer
Dim docNameField, strDocName, strDefpath, strDirname, savePath As String


ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
lastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord


For rec = 1 To ActiveDocument.MailMerge.DataSource.RecordCount


ActiveDocument.MailMerge.DataSource.ActiveRecord = rec


strDocName = ActiveDocument.MailMerge.DataSource.DataFields("LastName").Value & ", " & ActiveDocument.MailMerge.DataSource.DataFields("FirstName").Value & ".pdf"
strDefpath = Application.ActiveDocument.Path
strDirname = ActiveDocument.MailMerge.DataSource.DataFields("Supervisor").Value


With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
With .DataSource
.firstRecord = rec
.lastRecord = rec
.ActiveRecord = rec


End With
.Execute
End With




If Len(Dir(strDefpath & "\" & strDirname, vbDirectory)) = 0 Then


MkDir (strDefpath & "\" & strDirname)


End If


savePath = strDefpath & "\" & strDirname & "\" & strDocName


ActiveDocument.ExportAsFixedFormat OutputFileName:=savePath, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close False


ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord


Next rec





End Sub