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?