Rob_010101
Board Regular
- Joined
- Jul 24, 2017
- Messages
- 198
- Office Version
- 365
- Platform
- Windows
Wondering if someone can help me with the below code.
I got made redundant from a company and saved this code for use in the new job. It worked at the previous place but now, oddly, it's saving PDFs with the file extension ".22" (a 22 File). Never seen this before..
The idea of the below is to split mail merge letters into individual word and PDF documents, driven by a column labelled "File Name" in the excel sheet.
I got made redundant from a company and saved this code for use in the new job. It worked at the previous place but now, oddly, it's saving PDFs with the file extension ".22" (a 22 File). Never seen this before..
The idea of the below is to split mail merge letters into individual word and PDF documents, driven by a column labelled "File Name" in the excel sheet.
VBA Code:
Sub Split_To_Word_And_PDF()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
SelectedPath = vrtSelectedItem
Next vrtSelectedItem
Else
MsgBox ("No Directory Selected. Exiting")
Exit Sub
End If
End With
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("File_Name")
End With
.Execute Pause:=False
Application.ScreenUpdating = False
End With
'export pdf
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
ActiveDocument.Saved = True
'export word
ActiveDocument.SaveAs2 FileName:=docname & ".docx"
ActiveDocument.Saved = True
ActiveDocument.ActiveWindow.Close savechanges:=wdDoNotSaveChanges
Documents(MainDoc).Activate
Next I
Application.ScreenUpdating = True
End Sub