Microsoft VBA Script to save mail merged word documents into separate files

' First add the mail merged fields and save the document

'Then reopen the word document and click no to SQL import and open VBA editor and paste this script

'Finally save this as a macro enabled document and test this code

'Happy coding

Option Explicit

Dim FOLDER_SAVED As String

Dim SOURCE_FILE_PATH As String

Function ReplaceIllegalCharacters(strIn As String, strChar As String) As String

    Dim strSpecialChars As String

    Dim i As Long

    strSpecialChars = "~""#%&*:<>?{|}/\[]" & Chr(10) & Chr(13)

    For i = 1 To Len(strSpecialChars)

        strIn = Replace(strIn, Mid$(strSpecialChars, i, 1), strChar)

    Next

    ReplaceIllegalCharacters = strIn

End Function

Sub TestRun()

Dim MainDoc As Document, TargetDoc As Document

Dim dbPath As String, FileName As String, Folder As String

Dim recordNumber As Long, totalRecord As Long, startingRec As Integer, endingIndex As Integer

Dim Answer As VbMsgBoxResult

Set MainDoc = ActiveDocument

FOLDER_SAVED = "C:\temp\new\"

SOURCE_FILE_PATH = "C:\temp\Content-Planning-EN-Dev.xlsx"

      startingRec = 1

      Dim userdata As Variant, userdata2 As Variant, userdata3 As Variant, userdata4 As Variant

With MainDoc.MailMerge

        

        

        

        

        

        userdata3 = InputBox("Please enter the source file path", "Destination folder", "C:\temp\Content-Planning-EN-Dev.xlsx")

        

        FileName = VBA.FileSystem.Dir(userdata3)

        

        If FileName = "" Then

        MsgBox "File does not exist."

        Else

        SOURCE_FILE_PATH = userdata3

        End If

        

        

        userdata4 = InputBox("Please enter the destination folder", "Destination folder", "C:\temp\new\")

        

        Folder = Dir(userdata4, vbDirectory)

        

         If Folder = "" Then

        Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")

        Select Case Answer

                Case vbYes

                    VBA.FileSystem.MkDir (userdata4)

                Case Else

                    Exit Sub

        End Select

    

        Else

    

            'MsgBox "Folder exists."

            FOLDER_SAVED = userdata4

    

        End If

        '// if you want to specify your data, insert a WHERE clause in the SQL statement

        .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [Briefings$]"

            

        totalRecord = .DataSource.RecordCount

    

        

        

        userdata = InputBox("Please enter starting Index", "starting Index", 1)

        If IsNumeric(userdata) Then

        startingRec = userdata

        Else

        MsgBox "Not a Number"

        Exit Sub

        End If

        

        

        userdata2 = InputBox("Please enter Ending Index", "Ending Index", totalRecord)

        If IsNumeric(userdata2) Then

        

            endingIndex = userdata2

            

            If (endingIndex > totalRecord Or endingIndex < 1) Then

            MsgBox "Out of range"

            Exit Sub

             

            Else

            totalRecord = endingIndex

            

            

            End If

        

          

        End If

        

        

        

        

        

        

        

        

        

        

        '.DataSource.DataFields("Topic").Value

        

        

        For recordNumber = startingRec To totalRecord

        

            With .DataSource

                .ActiveRecord = recordNumber

                .FirstRecord = recordNumber

                .LastRecord = recordNumber

            End With

            

            .Destination = wdSendToNewDocument

            .Execute False

            

            Set TargetDoc = ActiveDocument

            Word.Options.AutoFormatReplaceHyperlinks = True

            TargetDoc.Range.AutoFormat

            TargetDoc.SaveAs2 FOLDER_SAVED & ReplaceIllegalCharacters(.DataSource.DataFields("Topic").Value, "_") & ".docx", wdFormatDocumentDefault

            'TargetDoc.ExportAsFixedFormat FOLDER_SAVED & .DataSource.DataFields("Client_Name").Value & ".pdf", exportformat:=wdExportFormatPDF

            

            TargetDoc.Close False

            

            Set TargetDoc = Nothing

                    

        Next recordNumber

End With

Set MainDoc = Nothing

End Sub