Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 12-01-2021, 08:15 PM
user4829 user4829 is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Novice
Automate mail merge to save each record individually using VBA
 
Join Date: Dec 2021
Posts: 6
user4829 is on a distinguished road
Default Automate mail merge to save each record individually using VBA

Hi,

I am trying to automate mail merge to save each record individually using VBA. I know there are a lot of guides and tutorials out there, I have tried a few and had no luck. The best success I've had so far is the code below, pulled from
HTML Code:
https://swissmacuser.ch/microsoft-word-mail-merge-into-single-documents/
.

This currently works to export a document from mail merge and save as individual file, it just appears to save the same document over the top of each other. E.g. I will end up with only one merged document at the end as the others were saved over during the process. I can see in preview mode when I run the macro, the file saving over itself and updating content.


Here is my code:

Sub SaveIndividualWordFiles()
Dim iRec As Integer
Dim docMail As Document
Dim docLetters As Document
Dim savePath As String

Set docMail = ActiveDocument


''There is a problem with the recordcount property returning -1
''http://msdn.microsoft.com/en-us/library/office/ff838901.aspx

savePath = ActiveDocument.Path & ""

ActiveDocument.MailMerge.DataSource.lastRecord = wdLastRecord
iRec = ActiveDocument.MailMerge.DataSource.ActiveRecord
ActiveDocument.MailMerge.DataSource.FirstRecord = wdFirstRecord

For i = 1 To iRec
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.lastRecord = i
'' This will be the file name
'' the test data source had unique surnames
'' in a field (column) called FileName
sFName = .DataFields("Title").Value
End With
.Execute Pause:=False
Set docLetters = ActiveDocument
End With

' Save generated document and close it after saving
docLetters.SaveAs FileName:=savePath & sFName & ".docx"
docLetters.Close False

docMail.MailMerge.DataSource.ActiveRecord = wdNextRecord
Next
End Sub

Reply With Quote
  #2  
Old 12-01-2021, 10:24 PM
gmayor's Avatar
gmayor gmayor is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Expert
 
Join Date: Aug 2014
Posts: 3,711
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

The following will work, however may I suggest you look at the merge to documents mode of E-Mail Merge Add-in

Code:
Option Explicit

Sub SaveIndividualWordFiles()
Dim i As Long
Dim docMail As Document
Dim docLetters As Document
Dim savePath As String, sFName As String

    Set docMail = ActiveDocument
    savePath = docMail.path & "\"

    With docMail.MailMerge
        For i = 1 To .DataSource.RecordCount
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i
                '' This will be the file name
                '' the test data source had unique surnames
                '' in a field (column) called FileName
                sFName = .DataFields("Title").value
            End With
            .Execute Pause:=False
            Set docLetters = ActiveDocument

            ' Save generated document and close it after saving
             docLetters.SaveAs FileName:=savePath & sFName & ".docx"
            docLetters.Close False
            DoEvents
        Next
    End With
Set docMail = Nothing
Set docLetters = Nothing
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 12-02-2021, 10:15 PM
user4829 user4829 is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Novice
Automate mail merge to save each record individually using VBA
 
Join Date: Dec 2021
Posts: 6
user4829 is on a distinguished road
Default

@gmayor

I have tried the code you posted with no success. Using step into, it gets to "For i = 1 To .DataSource.RecordCount" and moved straight to "End With"

Any thoughts or advice?

Unfortunately I don't have to option to install an Add-in for this.
Reply With Quote
  #4  
Old 12-03-2021, 02:08 PM
macropod's Avatar
macropod macropod is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,252
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

See Send Mailmerge Output to Individual Files in the Mailmerge Tips & Tricks 'Sticky' thread at the top of the Mailmerge forum: https://www.msofficeforums.com/mail-...ps-tricks.html
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #5  
Old 12-05-2021, 06:34 PM
user4829 user4829 is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Novice
Automate mail merge to save each record individually using VBA
 
Join Date: Dec 2021
Posts: 6
user4829 is on a distinguished road
Default

This VBA did not work for me. When I run the macro, nothing happens.
Reply With Quote
  #6  
Old 12-05-2021, 09:42 PM
gmayor's Avatar
gmayor gmayor is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Expert
 
Join Date: Aug 2014
Posts: 3,711
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

Dis you have a datasource attached to the merge document?
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #7  
Old 12-05-2021, 10:57 PM
user4829 user4829 is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Novice
Automate mail merge to save each record individually using VBA
 
Join Date: Dec 2021
Posts: 6
user4829 is on a distinguished road
Default

Yes, example data source attached and merge template attached.
Attached Files
File Type: docm Merge Template.docm (23.8 KB, 1 views)
File Type: xlsx DATASET_1 copy.xlsx (8.0 KB, 1 views)
Reply With Quote
  #8  
Old 12-06-2021, 01:34 AM
gmayor's Avatar
gmayor gmayor is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Expert
 
Join Date: Aug 2014
Posts: 3,711
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

If the data sheet was viable (It has an incompatible ROW1 and several empty rows after the sixth record) and you remove the unassociated field from the document then save it as a DOCX format (see attached) the code I posted works without problem. See attached. You'll need to reattach the data file.
Run the code from your normal template.
Attached Files
File Type: zip Example.zip (19.9 KB, 1 views)
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #9  
Old 12-06-2021, 02:29 AM
user4829 user4829 is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Novice
Automate mail merge to save each record individually using VBA
 
Join Date: Dec 2021
Posts: 6
user4829 is on a distinguished road
Default

I am still having some trouble. I have had 2 outcomes:

1. When I first connect the data source and run the macro I have to run it 3-4 times and it either exports 1,2 or 3 files (screen recording attached)

2. When I delete those saved files from the folder (Created above) and I run the macro, I can see the preview of the file exporting all of the different data and saving the file on top of itself (screen recording attached), so I only end up with one file.

Any thoughts on why this might be?
Attached Files
File Type: zip 1. multiple macro runs needed.gif.zip (1.89 MB, 3 views)
File Type: zip 2. file saving over itself.gif.zip (860.2 KB, 1 views)
Reply With Quote
  #10  
Old 12-06-2021, 02:59 AM
gmayor's Avatar
gmayor gmayor is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Expert
 
Join Date: Aug 2014
Posts: 3,711
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

If the field chosen for the filename contains the same data for multiple records then of course the documents will be overwritten by subsequent records. The sample data you provided has different data in each record in the Title field and so produces six documents.
If you want to account for duplicate names, you need a lot more code. You will also need to test for illegal filename characters (there were none in your Title field example) and it is probably wider to use a subfolder to save the merged documents. The following does that also.
Code:
Option Explicit

Sub SaveIndividualWordFiles()
Dim i As Long
Dim docMail As Document
Dim docLetters As Document
Dim savePath As String, sFName As String

    Set docMail = ActiveDocument
    savePath = docMail.path & "\Merged Documents\"
    CreateFolders savePath

    With docMail.MailMerge
        For i = 1 To .DataSource.RecordCount
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i
                sFName = .DataFields("Title").value
                sFName = CleanFilename(sFName)
                sFName = FileNameUnique(savePath, sFName, "docx")
            End With
            .Execute Pause:=False
            Set docLetters = ActiveDocument
            docLetters.SaveAs FileName:=savePath & sFName & ".docx"
            docLetters.Close False
            DoEvents
        Next
    End With
    Set docMail = Nothing
    Set docLetters = Nothing
End Sub

Private Function CleanFilename(strFileName As String) As String
Dim arrInvalid() As String
Dim lng_Index As Long
    'Define illegal characters (by ASCII CharNum)
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    'Remove any illegal filename characters
    CleanFilename = strFileName
    For lng_Index = 0 To UBound(arrInvalid)
        CleanFilename = Replace(CleanFilename, Chr(arrInvalid(lng_Index)), Chr(95))
    Next lng_Index
lbl_Exit:
    Exit Function
End Function

Private Function FileNameUnique(strPath As String, _
                                strFileName As String, _
                                strExtension As String) As String
'Graham Mayor - http://www.gmayor.com - Last updated - 22 Jun 2018
'strPath is the path in which the file is to be saved
'strFilename is the filename to check
'strExtension is the extension of the filename to check
Dim lng_F As Long
Dim lng_Name As Long
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Do Until Right(strPath, 1) = "\"
        strPath = strPath & "\"
    Loop
    If InStr(1, strFileName, "\") > 0 Then
        strFileName = Mid(strFileName, InStrRev(strFileName, "\") + 1)
    End If
    strExtension = Replace(strExtension, Chr(46), "")
    lng_F = 1
    If InStr(1, strFileName, strExtension) > 0 Then
        lng_Name = Len(strFileName) - (Len(strExtension) + 1)
    Else
        lng_Name = Len(strFileName)
    End If
    strFileName = Left(strFileName, lng_Name)
    'If the filename exists, add or increment a number to the filename
    'and keep checking until a unique name is found
    Do While FSO.FileExists(strPath & strFileName & Chr(46) & strExtension) = True
        strFileName = Left(strFileName, lng_Name) & "(" & lng_F & ")"
        lng_F = lng_F + 1
    Loop
    'Reassemble the filename
    FileNameUnique = strFileName
lbl_Exit:
    Set FSO = Nothing
    Exit Function
End Function

Private Sub CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim oFSO As Object
Dim lng_PathSep As Long
Dim lng_PS As Long
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    lng_PathSep = InStr(3, strPath, "\")
    If lng_PathSep = 0 Then GoTo lbl_Exit
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Do
        lng_PS = lng_PathSep
        lng_PathSep = InStr(lng_PS + 1, strPath, "\")
        If lng_PathSep = 0 Then Exit Do
        If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until lng_PathSep = 0
        If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
            oFSO.CreateFolder Left(strPath, lng_PathSep)
        End If
        lng_PS = lng_PathSep
        lng_PathSep = InStr(lng_PS + 1, strPath, "\")
    Loop
lbl_Exit:
    Set oFSO = Nothing
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #11  
Old 12-06-2021, 03:28 AM
user4829 user4829 is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Novice
Automate mail merge to save each record individually using VBA
 
Join Date: Dec 2021
Posts: 6
user4829 is on a distinguished road
Default

Thank you for the extra detailed code.

There were no repeat file names or illegal file names. I used the same sample data to test and screen record. There must be something odd with my computer not running it if it worked on your computer. I will test on windows in the office and report back - that might be the issue (currently testing on Mac (and remembering to change file path to / from \))

The longer code also didn't seem to register on my mac. Running macro just did nothing. Didn't run an error or anything. Hopefully the shorter version will work on windows, if not I will try this out.

Thanks for your help so far - much appreciated.
Reply With Quote
  #12  
Old 12-06-2021, 04:51 AM
gmayor's Avatar
gmayor gmayor is offline Automate mail merge to save each record individually using VBA Windows 10 Automate mail merge to save each record individually using VBA Office 2019
Expert
 
Join Date: Aug 2014
Posts: 3,711
gmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to beholdgmayor is a splendid one to behold
Default

Your profile indicates that you are using Windows 10 and Office 2019. Non code is not tested on a Mac and may not work with that operating system.
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
Reply

Tags
mail merge, mail merge code, mail merge saving

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Automate mail merge to save each record individually using VBA How to mail merge next record on same page to save paper klc9761 Mail Merge 1 04-22-2017 02:29 PM
Automate mail merge to save each record individually using VBA Showing record number during mail merge catflap Mail Merge 1 04-13-2017 07:32 AM
Automate mail merge to save each record individually using VBA Mail Merge Next Record If rule RHensley Mail Merge 10 03-07-2017 08:05 AM
Automate mail merge to save each record individually using VBA Automate daily mail merge JCInfo Mail Merge 4 12-02-2013 05:12 PM
avoid duplicete record and merge the record with the existed record hemant.behere Excel 0 01-10-2012 02:53 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:26 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2022, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2022 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft