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



Windows(MainDoc).Activate
Next i

Application.ScreenUpdating = True


End Sub