Save each individual merged document as its own file

macropod · #1 10-03-2019, 07:15 PM

There's any number of possibilities, including:
1. You're not running the code from a mailmerge main document; and/or

2. You haven't edited the 'Last_Name' & 'First_Name' references in the code to reflect your own field names.

sdemuth@earthlink.net · #2 10-04-2019, 09:37 AM

Hi Paul -

Thanks for replying. I have the following code from the internet. Can you check it to see if there is something wrong with the changes I made to it?

Also, I put it under the VBA code where it says (General) on the left-hand side at the top and the right-hand drop down is Merge_To_Individual_Files. Is that right?

I tried running it by pressing F5 and it just sits there.

Code:

Sub Merge_To_Individual_Files()
' Sourced from: https://www.msofficeforums.com/mail-...ps-tricks.html
Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & Application.PathSeparator
  
  For i = 1 To .MailMerge.DataSource.RecordCount
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("Report_Name")) = "" Then Exit For
        'StrFolder = .DataFields("Folder") & Application.PathSeparator

        StrName = .DataFields("Report_Name")
            '& "_" & .DataFields("First_Name")
      End With
      .Execute Pause:=False
      If Err.Number = 5631 Then
        Err.Clear
        GoTo NextRecord
      End If
    End With
      For j = 1 To Len(StrNoChr)
        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
      Next
    StrName = Trim(StrName)
    With ActiveDocument
      'Add the name to the footer
      '.Sections(1).Footers(wdHeaderFooterPrimary).Range.InsertBefore StrName
      .SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

      ' and/or:
      '.SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      '.Close SaveChanges:=False
    End With
NextRecord:
  Next i
End With

Application.ScreenUpdating = True
End Sub

Any help will be appreciated!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Splitting merged Word document into individual .pdf documents (naming from a field in the file)	ScarlettNZ	Mail Merge	1	05-30-2019 12:53 AM
Word crashes if the merged document file is closed first	reidtaylor	Mail Merge	7	05-07-2019 04:19 AM
Save a section as individual document.	eduzs	Word VBA	1	10-29-2018 07:35 AM
How can I save a Word Document as a PDF file with a merged field filename?	kp2009	Word VBA	5	08-27-2015 11:45 PM
Save merged document as concatenated merge field values	texas791	Word VBA	4	02-25-2014 07:35 PM