Word 2016 Mail Merge to save to individual PDF files

[accesskhatua]

Hi All,

I am new to vba.

i have found a word vba which is saving individual mail merge to pdf files.
But for this i have to pick the folder to store the pdf files.

Is it possible to modify the macro to automatically save all files to a particular folder location instead of manually selecting a folder location.


Below is the complete code i am using

Sub ConfirmationLetter()
'
' ConfirmationLetter Macro
'
'
' merge1record_at_a_time Macro
'
'
    Dim fd As FileDialog
    
    'Delete old letters
    
    
    Dim aFile As String
    aFile = "C:\DailyData\Data\MR\Deployment\Letters\*."
    If Len(Dir$(aFile)) > 0 Then
    Kill aFile
    End If
    
    
    On Error GoTo 0


    'Create a FileDialog object as a Folder Picker dialog box.
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    With fd

        'Use the Show method to display the Folder Picker dialog box and return the user's action.
        'The user pressed the button.
        If .Show = -1 Then
                For Each vrtSelectedItem In .SelectedItems


                'vrtSelectedItem is aString that contains the path of each selected item.
                'You can use any file I/O functions that you want to work with this path.
                'This example displays the path in a message box.
        SelectedPath = vrtSelectedItem


        Next vrtSelectedItem

        Else
        MsgBox ("No Directory Selected.  Exiting")
        Exit Sub
        End If
    End With


    'Set the object variable to Nothing.
    Set fd = Nothing

Application.ScreenUpdating = False


MainDoc = ActiveDocument.Name
    ChangeFileOpenDirectory SelectedPath
    For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
        With ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i
                docName = .DataFields("Name").Value & ".pdf"      ' ADDED CODE
            End With
            .Execute Pause:=False
    Application.ScreenUpdating = False
            
        End With
        
        
        ActiveDocument.ExportAsFixedFormat OutputFileName:=docName, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
        ActiveWindow.Close SaveChanges:=False
        
      
        
   ' ActiveDocument.SaveAs FileName:=docName, FileFormat:= _
   '     wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
     '   :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
    '    :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
    '    SaveAsAOCELetter:=False
    'ActiveWindow.Close


    Windows(MainDoc).Activate
    Next i
    
Application.ScreenUpdating = True


End Sub