View Single Post
 
Old 04-30-2024, 06:36 AM
Chris_010101's Avatar
Chris_010101 Chris_010101 is offline Windows 11 Office 2021
Novice
 
Join Date: Sep 2022
Posts: 4
Chris_010101 is on a distinguished road
Default Mail Merge Macro - Saves to PDF/Word

Hello

I use a macro to save mail merged documents into word and PDF files; very handy.


I must select all the rows above the row I need in the recipient list for it to work. If I only ticked "Sam" and left "Connor" and "Vincent" unticked, the macro will produce a "runtime error 5631" on

Code:
.Execute Pause:=False
Visa versa, if I ticked "Connor" and left "Sam" unticked, as long as "Vincent" is ticked, the macro will work.

This is unmanageable with 1000's of rows. The macro takes ages to run and I then have to delete all the documents I don't need after.

MS Forum Pic.png

Is it possible to fix the below so it will run on any row/rows I have selected in the recipient list, regardless of if the leading rows are selected?

Code:
Sub Split_2_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
Thanks
Reply With Quote