Microsoft Office Forums - [Solved] Compatibility of 2 macros in mail merge: Delete table rows + save individual PDFs

Microsoft Office Forums (https://www.msofficeforums.com/)

- Word VBA (https://www.msofficeforums.com/word-vba/)

- -

Compatibility of 2 macros in mail merge: Delete table rows + save individual PDFs (https://www.msofficeforums.com/word-vba/38237-compatibility-2-macros-mail-merge-delete-table.html)

Compatibility of 2 macros in mail merge: Delete table rows + save individual PDFs

I'm writing a mail merge letter, but before I keep going, I'd need to know if the use of these two macros would work:

MACRO 1 (Deletes row, if first column = $)

Code:

Sub ScratchMacro()

'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 2/12/2018

Dim oTbl As Table

Dim lngIndex As Long

  For Each oTbl In ActiveDocument.Tables

    For lngIndex = oTbl.Rows.Count To 1 Step -1

       If Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2) = "$" Then

         oTbl.Rows(lngIndex).Delete

       End If

    Next

  Next

lbl_Exit:

  Exit Sub

End Sub

MACRO 2 (Saves all mail merge documents as individual PDF files)

Code:

Sub merge1record_at_a_time() '

' merge1record_at_a_time Macro

'

'

    Dim fd As FileDialog





    '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 = "Letter1 - " & .DataFields("Contact1").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

Both of these macros work perfectly on their own, but I'd need MACRO 1 to apply to the letters, before these are saved as PDFs with MACRO 2. I believe MACRO 1 needs to be run after finalizing the mail merge, whilst I've only used MACRO 2 before finalizing the mail merge.

Instead of trying to reinvent the wheel, you might explore some of the solutions that have already been created.

For example, you could use a DATABASE field in a normal ‘letter’ mailmerge main document and a macro to drive the process. An outline of this approach can be found at: http://answers.microsoft.com/en-us/o...1-1996c14dca5d
Conversely, if your workbook has a separate sheet with just a single instance of each of the grouping criteria, a DATABASE field in a normal ‘letter’ mailmerge main document could be used without the need for a macro. An outline of this approach can be found at: https://answers.microsoft.com/en-us/...f-8642e46fa103
For a working example, see: https://www.msofficeforums.com/mail-...-multiple.html

Alternatively, you may want to try one of the Many-to-One Mail Merge add-ins, from:
Graham Mayor at http://www.gmayor.com/ManyToOne.htm; or
Doug Robbins at http://bit.ly/1hduSCB

Thanks for the response. I got lost with the whole DATABASE thing.

I'm trying Graham Mayor's many to one add in, but I can't get it to work properly.

At first I got Error '4198' Command Failed. I searched and I found out it might have something to do with my Acer Add In, so I disabled that via Options -> Add ins.

That kinda worked as now 5 or 6 letters are being saved, but then the same errors pop up again. Also, those letters are just individual pages, so a letter that's supposed to be 4 or 5 pages long, gets split into multiple individual files.

I also preferred that ability of naming each letter via:

docName = "Letter of renewal - Owner: " & .DataFields("Contact1").Value & ".pdf"

Because this Add In, only allows me to name the letters with a DataField, without adding any other info.

Basically what I need to know is if its possible and how to:

Save each multipage letter as an individual PDF, after I've hit the Finish & Merge button and I'm on the subsequent document that shows up.

Also, having something that allows me to name each PDF with a Generic+Personalised name, with something like: docName = "Letter of renewal - Owner: " & .DataFields("Contact1").Value & ".pdf"

MACRO 2 worked great but before clicking on Finish & Merge.

Thankss!

Your second macro only outputs one record per letter, but your first one implies you have a multi-row table for which some rows may be empty. That implies you're trying to process multiple records per letter - which your first macro doesn't do. Perhaps you could explain in more detail what you're trying to achieve.

Ok so different letters have different number of items, which are listed in a table. Seeing how field codes don't disappear when in tables, I introduced the following functions into the rows in column A:

{ IF { Mergefield Item1 } = "" "$" "{ Mergefield Item1 }" }
{ IF { Mergefield Item2 } = "" "$" "{ Mergefield Item2 }" }
{ IF { Mergefield Item3 } = "" "$" "{ Mergefield Item3 }" }
...

So when there's no ItemX, $ is introduced and then my MACRO 1 deletes all those empty rows. This is working great.

To use this MACRO 1, I need to click on Finish and Merge first to have all the letters show up. Once all the empty spaces are deleted with this MACRO1, I'd need to save the records as individual PDFs.

In essence, the problem is:
MACRO 1 -> Only works after Finish and Merge
MACRO 2 -> Only works before Finish and Merge

Could these macros be tweaked in some way? Any alternative that isn't too time consuming?

Thanks for your time Paul, bare with me, my knowledge on this is limited :(

Try the following macro - it's based on one in my Mailmerge Tips & Tricks thread (https://www.msofficeforums.com/mail-...ps-tricks.html):

Code:

Sub Merge_To_Individual_Files()

' Merges one record at a time to the folder containing the mailmerge main document.

' Based on: https://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html

Application.ScreenUpdating = False

Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long, Tbl As Table

Const StrNoChr As String = """*./\:?|"

Set MainDoc = ActiveDocument

With MainDoc

  StrFolder = .Path & Application.PathSeparator

  For i = 1 To .MailMerge.DataSource.RecordCount

    With .MailMerge

      .Destination = wdSendToNewDocument

      .SuppressBlankLines = True

      With .DataSource

        .FirstRecord = i

        .LastRecord = i

        .ActiveRecord = i

        If Trim(.DataFields("Contact1")) = "" Then Exit For

        StrName = .DataFields("Contact1")

      End With

      .Execute Pause:=False

    End With

      For j = 1 To Len(StrNoChr)

        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")

      Next

    StrName = "Letter1 - " & Trim(StrName)

    With ActiveDocument

      For Each Tbl In .Tables

        With Tbl

          For j = .Rows.Count To 1 Step -1

            If Trim(Split(.Cell(j, 1).Range.Text, vbCr)(0)) = "$" Then .Rows(j).Delete

          Next

        End With

      Next

      .SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

      ' and/or:

      .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False

      .Close SaveChanges:=False

    End With

  Next i

End With

Application.ScreenUpdating = True

End Sub

Thanks Paul. In order to have the files saved with a particular name, do I need to edit the line:

Code:

StrName = .DataFields("Contact1")

Or the lines

Code:

.SaveAs FileName:=StrFolder & StrName & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

      ' and/or:

      .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False

      .Close SaveChanges:=False

Thanks and sorry my ignorance :(

Quote:

Originally Posted by Btop (Post 124878)

In order to have the files saved with a particular name, ...

That's already taken care of, via:

Code:

StrName = "Letter1 - " & Trim(StrName)

and:

Code:

.SaveAs FileName:=StrFolder & StrName(StrName)

plus the relevant .docx/.pdf extension.

I'm getting error 5941 with this line:

Code:

If Trim(.DataFields("Contact1")) = "" Then Exit For

Are you sure your field's name is 'Contact1'?

:eek: **somebody please shoot me**

I was missing a letter... Sorry, that was very stupid on my part haha.

Now I get error 5631 with something like:

Word couldn't combine the main document with the data source because of the registries were empty or because there were no registries with data that coincided with the consulted options.

At line:

Code:

.Execute Pause:=False

I believe the error message says:

Quote:

Runtime error - 5631:
Word could not merge the main document with the data source because the data records were empty or no data records matched your query options

Basically, that means you've connected to a data source that contains no records, or none that match whatever filters you've applied.

:confused:

It's working fine, if I simply go Finish and Merge without the macro. So it must be related to the macro.

When should I be running the macro? Before Finish and Merge? Should I click on Edit individual documents first?

You would run the macro instead of 'Finish and Merge'.