Access VBA Mail Merge Split to PDF and Word

[JimLes]

This code works very well and does split the files into word and pdf from my access table, however, it groups them into one file.

For example, if I have two names in my table:
John Doe
Jane Doe

It will create a PDF/Word named John Doe and Jane Doe, however, John and Jane are in the same file for each of the mail merges. It seems to be adding tee loop together for the record count. Any Ideas??

here is my code:

Private Sub Command1338_Click()
On Error GoTo Err_Command1338
Dim currentDbName As String
Dim strList As String
Dim ObjWordApp As Word.Application
Dim ObjWord As Word.Document
DoCmd.SetWarnings False
strList = Forms![frmSeverance]![Manager]
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant
Set MyDB = CurrentDb()
Dim rec, LastRecord As Integer
Dim docNameField, strDocName, strPDFName, savePath As String


If strList = "Test Letter" Then
        Set ObjWordApp = CreateObject("Word.Application")
        Set ObjWord = ObjWordApp.Documents.Open("C:\TestLetter.docx")
        ObjWordApp.Application.Visible = True
        ObjWord.MailMerge.OpenDataSource _
        Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
        sqlstatement:="SELECT * FROM [tblSeveranceLetters]"
        ObjWord.MailMerge.DataSource.ActiveRecord = wdLastRecord
        LastRecord = ObjWord.MailMerge.DataSource.ActiveRecord
        If MsgBox(LastRecord & " employee letters will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
            savePath = "C:\Completed Letters\"
            docNameField = ("Name")
        For rec = ObjWord.MailMerge.DataSource.FirstRecord To LastRecord
            ObjWord.MailMerge.DataSource.ActiveRecord = rec
            strDocName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".docx"
            strPDFName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".pdf"
        With ObjWord.MailMerge
            .Destination = wdSendToNewDocument
            .Execute
        End With
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strDocName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strPDFName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.Close False
            ObjWordApp.ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
        Next rec
        Else
            Exit Sub
End If

 

[Andrzejek]

What happens when you stop (break) on
[tt]For rec = ObjWord.MailMerge.DataSource.FirstRecord To LastRecord[/tt]

Do you have it working like:
[tt]For rec = 1 To 2[/tt]

And what do you get when you step thru your code?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[JimLes]

When it stops for the message below, it shows 2 records to be processed, however, it seems to be looping through through both records at once and processing them in one file. It does create 2 Word and 2 PDF, but both employees are in each file.

If MsgBox(LastRecord & " employee severance agreements will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
            savePath = "C:\Completed Letters\"
            docNameField = ("Name")

 

[JimLes]

I tried this and it only outputs one employee per file but it will only run the first record in the table.

If strList = "Test Letter" Then
Set ObjWordApp = CreateObject("Word.Application")
        Set ObjWord = ObjWordApp.Documents.Open("C:\TestLetter.docx")
        ObjWordApp.Application.Visible = True
        ObjWord.MailMerge.OpenDataSource _
        Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
        sqlstatement:="SELECT * FROM [tblSeveranceLetters]"
        
        ObjWord.MailMerge.DataSource.ActiveRecord = wdLastRecord
        LastRecord = ObjWord.MailMerge.DataSource.ActiveRecord
        'rec = ObjWord.MailMerge.DataSource.ActiveRecord
        
        If MsgBox(LastRecord & " employee severance agreements will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
            savePath = "C:\Completed Letters\"
            docNameField = ("Name")
            
        ObjWord.MailMerge.DataSource.ActiveRecord = wdFirstRecord
        rec = ObjWord.MailMerge.DataSource.ActiveRecord
        
        For i = 1 To rec
                With ObjWord.MailMerge
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
            
                With .DataSource
                    .FirstRecord = i
                    .LastRecord = i
                    .ActiveRecord = i
                    strDocName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".docx"
                    strPDFName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".pdf"
                End With
            .Execute Pause:=False
            
            End With
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strDocName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strPDFName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.Close False
            ObjWordApp.ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
            
        Next
        Else
            Exit Sub
        End If

 

[Andrzejek]

I would try to modify [blue]this[/blue]:

ObjWord.MailMerge.OpenDataSource _
Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
sqlstatement:="SELECT * FROM [tblSeveranceLetters][blue] WHERE FullName = 'John Doe'[/blue]"

so you can get just one record to process. And see if you get what you want in the one Word and one PDF files.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Andrzejek]

Is the [tt]docNameField[/tt] value different for each record?

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[JimLes]

yes, I am trying to output everything in the tblSeveranceLetters to a mailmerge that saves each by a Word and PDF with the employee's name as the filename.

It works perfect only, it bundles them.

 

[JimLes]

I don't believe I can modify the opendatasource to equal one name because I could have up to 100 employees in that table to process to letters.

The names change with every run.

 

[Andrzejek]

How about something like:
(pseudo code]

With Rst
    .Open "SELECT * FROM [tblSeveranceLetters]"
    Do While Not .EOF[green]
        'Do All your Mail Merge here, one records at the time[/green]
        ...
        ObjWord.MailMerge.OpenDataSource _
        Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
         sqlstatement:="SELECT * FROM [tblSeveranceLetters] WHERE FullName = '[red]" & !FullName.Value & "[/red]'" 
        ...
        .MoveNext
    Loop
    .Close
End With
Set Rst = Nothing

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[JimLes]

Thanks! I will try that!!

 

[JimLes]

Okay, I got this far and it splits out the files like I need but it is stuck in a continual loop. Where am I going wrong?

ElseIf strList = "Test Merge" Then
        Set ObjWordApp = CreateObject("Word.Application")
        Set ObjWord = ObjWordApp.Documents.Open("C\TestDocument.docx")
        ObjWordApp.Application.Visible = True
        ObjWord.MailMerge.OpenDataSource _
        Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
        sqlstatement:="SELECT * FROM [tblSeveranceLetters]"
        
        ObjWord.MailMerge.DataSource.ActiveRecord = wdLastRecord
        LastRecord = ObjWord.MailMerge.DataSource.ActiveRecord
        If MsgBox(LastRecord & " employee severance agreements will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
            savePath = "C:\Completed Letters\"
            docNameField = ("Name")
        ObjWord.MailMerge.DataSource.ActiveRecord = wdFirstRecord
        
        With ObjWord.MailMerge
            .DataSource.ActiveRecord = wdFirstDataSourceRecord
         Do
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
         With .DataSource
            .FirstRecord = .ActiveRecord
            .LastRecord = .ActiveRecord
             strDocName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".docx"
             strPDFName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".pdf"
            .ActiveRecord = wdNextRecord
         End With
            .Execute Pause:=False
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strDocName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strPDFName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.Close
         Loop Until .DataSource.ActiveRecord = .DataSource.RecordCount
        
        End With
                                
        Else
            Exit Sub
        End If

 

[Andrzejek]

What are the values of [tt].DataSource.ActiveRecord[/tt] and [tt].DataSource.RecordCount[/tt]
at the end of your loop:
[tt]Loop Until .DataSource.ActiveRecord = .DataSource.RecordCount[/tt]
???

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[JimLes]

Well, I finally got it working with this code below. This is the same code as above that would only output one record but when I removed this code "ObjWord.MailMerge.DataSource.ActiveRecord = wdFirstRecord", it cycled through them all perfectly!! Thanks!!

If strList = "Test Merge" Then
        Set ObjWordApp = CreateObject("Word.Application")
        Set ObjWord = ObjWordApp.Documents.Open("C:\TestDocument.docx")
        ObjWordApp.Application.Visible = True
        ObjWord.MailMerge.OpenDataSource _
            Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
        sqlstatement:="SELECT * FROM [tblSeveranceLetters]"
            ObjWord.MailMerge.DataSource.ActiveRecord = wdLastRecord
            LastRecord = ObjWord.MailMerge.DataSource.ActiveRecord
        If MsgBox(LastRecord & " employee severance agreements will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
            savePath = "C:\Completed Letters\"
            docNameField = ("Name")
            
        rec = ObjWord.MailMerge.DataSource.ActiveRecord
        
        For i = 1 To rec
            With ObjWord.MailMerge
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = i
                .LastRecord = i
                .ActiveRecord = i
                 strDocName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".docx"
                 strPDFName = ObjWord.MailMerge.DataSource.DataFields(docNameField).Value & ".pdf"
            End With
                .Execute Pause:=False
            
            End With
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strDocName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.SaveAs Filename:=savePath & strPDFName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
            ObjWordApp.ActiveDocument.Close False
            ObjWordApp.ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
            
        Next
        Else
            Exit Sub
        End If