Consulting

Results 1 to 3 of 3

Thread: Mail Merge Document Splitter Works! Kind of...

  1. #1

    Mail Merge Document Splitter Works! Kind of...

    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?
    Last edited by TheSQLWasBet; 07-31-2018 at 12:16 PM.

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    3,526
    Location
    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-m...ps-tricks.html
    or:
    http://windowssecrets.com/forums/sho...ips-amp-Tricks
    That said, there's nothing apparent in your code that would account for what you've described.
    Last edited by macropod; 07-31-2018 at 03:13 PM.
    Cheers
    Paul Edstein
    [MS MVP - Word]

  3. #3
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •