VBA : Mail Merge to Save Each Record Individually [DOCX only]

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

hi expert..
this vba word code work properly, but i want to modified for setting "Folder Saved & Source File Path" is not manually again
this my steps:
1. i need like show message box like e.g. "please, select Folder Saved...." & "select "Source file path database......." then next step/OK
2. save each record as their own individual Word document only in .docx format not pdf with file name using data field "name_file"
here complete code:

Code: Select all

Option Explicit
Const [b]FOLDER_SAVED[/b] As String = "D:\TUTORIAL\PART1\Surat Tugas-"  'sesuaikan direktorinya
Const [b]SOURCE_FILE_PATH[/b] As String = "D:\TUTORIAL\PART1\database.xlsx" 'sesuaikan direktorinya
 
Sub MailMergeToIndPDF()
Dim MainDoc As Document, TargetDoc As Document
Dim dbPath As String
Dim recordNumber As Long, totalRecord As Long

Set MainDoc = ActiveDocument
With MainDoc.MailMerge
    
        '// if you want to specify your data, insert a WHERE clause in the SQL statement
        .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [Sheet1$]"
            
        totalRecord = .DataSource.RecordCount

        For recordNumber = 1 To totalRecord
        
            With .DataSource
                .ActiveRecord = recordNumber
                .FirstRecord = recordNumber
                .LastRecord = recordNumber
            End With
            
            .Destination = wdSendToNewDocument
            .Execute False
            
            Set TargetDoc = ActiveDocument

            TargetDoc.SaveAs2 FOLDER_SAVED & .DataSource.DataFields("[b]Name_File[/b]").Value & ".docx", wdFormatDocumentDefault '
            TargetDoc.ExportAsFixedFormat FOLDER_SAVED & .DataSource.DataFields("[b]Name_File[/b]").Value & ".pdf", exportformat:=wdExportFormatPDF 
            TargetDoc.Close False
            Set TargetDoc = Nothing
        Next recordNumber
End With
    On Error Resume Next
    Kill FOLDER_SAVED & "*.docx"
    On Error GoTo 0
Set MainDoc = Nothing
End Sub
any one , help me greatly appreciated..
susanto

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by HansV »

Try this version:

Code: Select all

Sub MailMergeToIndDocx()
    Dim SOURCE_FILE_PATH As String
    Dim FOLDER_SAVED As String
    Dim MainDoc As Document
    Dim TargetDoc As Document
    Dim dbPath As String
    Dim recordNumber As Long
    Dim totalRecord As Long

    With Application.FileDialog(1) ' msoFileDialogOpen
        .Filters.Clear
        .Filters.Add "Excel workbooks (*.xls, *.xlsx, *.xlsm, *.xlsb", "*xls;.xlsx;.xlsm;.xlsb"
        If .Show Then
            SOURCE_FILE_PATH = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        If .Show Then
            FOLDER_SAVED = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    Set MainDoc = ActiveDocument
    With MainDoc.MailMerge
        .OpenDataSource Name:=SOURCE_FILE_PATH, SQLStatement:="SELECT * FROM [Sheet1$]"
        totalRecord = .DataSource.RecordCount
        For recordNumber = 1 To totalRecord
            With .DataSource
                .ActiveRecord = recordNumber
                .FirstRecord = recordNumber
                .LastRecord = recordNumber
            End With
            .Destination = wdSendToNewDocument
            .Execute False
            Set TargetDoc = ActiveDocument
            TargetDoc.SaveAs2 FileName:=FOLDER_SAVED & .DataSource.DataFields("Name_File").Value & ".docx", _
                FileFormat:=wdFormatXMLDocument
            TargetDoc.Close False
            Set TargetDoc = Nothing
        Next recordNumber
    End With
    Set MainDoc = Nothing
End Sub
Best wishes,
Hans

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

hi Hans, thank but not working, my mail merge have done and normally working, but when running your code show message "Run Time Error 5 Invalid procedure call or argument"
using your code, how to correct step with i do.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by HansV »

If you click Debug, which line is highlighted?
Best wishes,
Hans

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by HansV »

Oh, I see my mistake. Change the .Filters.Add line to

Code: Select all

        .Filters.Add "Excel workbooks (*.xls, *.xlsx, *.xlsm, *.xlsb)", "*.xls;*.xlsx;*.xlsm;*.xlsb"
Sorry about that.
Best wishes,
Hans

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

hi hans, after that, i can't see individually document save? how to save it?

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by HansV »

Code: Select all

            TargetDoc.SaveAs2 FileName:=FOLDER_SAVED & .DataSource.DataFields("Name_File").Value & ".docx", _
                FileFormat:=wdFormatXMLDocument
should save the documents in the folder that you selected. Have you looked there?
Best wishes,
Hans

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

hi hans, not save the document in the folder, nothing new file anything

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

maybe something happen, when i running code then show dialog folder to select file, but after select name file, dialog folder show again (redundant), twice showing dialog folder box,
if possible (finish) maybe show information dialog like .e.g "10 Records is Done" or "All record is success"

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by HansV »

You get two prompts: the first is to select the source workbook with the records that you want to merge. The second is to select the output folder.

The output might be in the parent folder of the folder that you selected because of an error in the original macro. Try this version:

Code: Select all

Sub MailMergeToIndDocx()
    Dim SOURCE_FILE_PATH As String
    Dim FOLDER_SAVED As String
    Dim MainDoc As Document
    Dim TargetDoc As Document
    Dim dbPath As String
    Dim recordNumber As Long
    Dim totalRecord As Long

    With Application.FileDialog(1) ' msoFileDialogOpen
        .Title = "Select the source workbook"
        .ButtonName = "Select workbook"
        .Filters.Clear
        .Filters.Add "Excel workbooks (*.xls, *.xlsx, *.xlsm, *.xlsb)", "*.xls;*.xlsx;*.xlsm;*.xlsb"
        If .Show Then
            SOURCE_FILE_PATH = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        .Title = "Select the output folder"
        .ButtonName = "Select folder"
        If .Show Then
            FOLDER_SAVED = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    Set MainDoc = ActiveDocument
    With MainDoc.MailMerge
        .OpenDataSource Name:=SOURCE_FILE_PATH, SQLStatement:="SELECT * FROM [Sheet1$]"
        totalRecord = .DataSource.RecordCount
        For recordNumber = 1 To totalRecord
            With .DataSource
                .ActiveRecord = recordNumber
                .FirstRecord = recordNumber
                .LastRecord = recordNumber
            End With
            .Destination = wdSendToNewDocument
            .Execute False
            Set TargetDoc = ActiveDocument
            Debug.Print "Saving document " & .DataSource.DataFields("Name_File").Value & ".docx"
            TargetDoc.SaveAs2 FileName:=FOLDER_SAVED & "\" & .DataSource.DataFields("Name_File").Value & ".docx", _
                FileFormat:=wdFormatXMLDocument
            TargetDoc.Close False
            Set TargetDoc = Nothing
        Next recordNumber
    End With
    MsgBox "Processed " & totalRecord & " documents"
    Set MainDoc = Nothing
End Sub
Best wishes,
Hans

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

hi Hans, thanks for your kindness. working well..
i think this my last suggestion & if you have time from this case, how to add criteria:
message box/dialog to choice record that saved as document:
"Select record from.....to ......?

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by HansV »

Here you go:

Code: Select all

Sub MailMergeToIndDocx()
    Dim SOURCE_FILE_PATH As String
    Dim FOLDER_SAVED As String
    Dim MainDoc As Document
    Dim TargetDoc As Document
    Dim dbPath As String
    Dim recordNumber As Long
    Dim totalRecord As Long
    Dim FirstRec As Long
    Dim LastRec As Long

    With Application.FileDialog(1) ' msoFileDialogOpen
        .Title = "Select the source workbook"
        .ButtonName = "Select workbook"
        .Filters.Clear
        .Filters.Add "Excel workbooks (*.xls, *.xlsx, *.xlsm, *.xlsb)", "*.xls;*.xlsx;*.xlsm;*.xlsb"
        If .Show Then
            SOURCE_FILE_PATH = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        .Title = "Select the output folder"
        .ButtonName = "Select folder"
        If .Show Then
            FOLDER_SAVED = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    Set MainDoc = ActiveDocument
    With MainDoc.MailMerge
        .OpenDataSource Name:=SOURCE_FILE_PATH, SQLStatement:="SELECT * FROM [Sheet1$]"
        totalRecord = .DataSource.RecordCount
        Do
            FirstRec = Val(InputBox("Enter the first record to be included", "First Merge Record", 1))
            If FirstRec < 1 Or FirstRec > totalRecord Then
                MsgBox "Please enter a valid number between 1 and " & totalRecord
            Else
                Exit Do
            End If
        Loop
        Do
            LastRec = Val(InputBox("Enter the last record to be included", "Last Merge Record", totalRecord))
            If LastRec < FirstRec Or LastRec > totalRecord Then
                MsgBox "Please enter a valid number between " & FirstRec & " and " & totalRecord
            Else
                Exit Do
            End If
        Loop
        For recordNumber = FirstRec To LastRec
            With .DataSource
                .ActiveRecord = recordNumber
                .FirstRecord = recordNumber
                .LastRecord = recordNumber
            End With
            .Destination = wdSendToNewDocument
            .Execute False
            Set TargetDoc = ActiveDocument
            Debug.Print "Saving document " & .DataSource.DataFields("Name_File").Value & ".docx"
            TargetDoc.SaveAs2 FileName:=FOLDER_SAVED & "\" & .DataSource.DataFields("Name_File").Value & ".docx", _
                FileFormat:=wdFormatXMLDocument
            TargetDoc.Close False
            Set TargetDoc = Nothing
        Next recordNumber
    End With
    MsgBox "Processed " & LastRec - FirstRec + 1 & " documents"
    Set MainDoc = Nothing
End Sub
Best wishes,
Hans

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

hi Hans...
thank you but after run macro in step "Enter number ...between....." show message Run time error 5941 the requested number of the collection does not exist.
in Debug show "Debug.Print "Saving document " & .DataSource.DataFields("Name_File").Value & ".docx", after that the file can't save. (nothing new file appear).

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by HansV »

That suggests that there is no column named Name_File in the Excel workbook.
Best wishes,
Hans

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA : Mail Merge to Save Each Record Individually [DOCX only]

Post by Susanto3311 »

oh yes..i missing it you are right
thank for all, Hans