×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Mail Merge from Table Saving each record to Word and PDF

Mail Merge from Table Saving each record to Word and PDF

Mail Merge from Table Saving each record to Word and PDF

(OP)
I have a code that is working where I can select multiple employees from a list box to create a table and then mail merge the data to a word document.

Here is my current code:

CODE --> VBA

Dim currentDbName As String
Dim strList As String
Dim ObjWord As Word.Document
DoCmd.SetWarnings False
strList = Forms![frmSeverance]![SeveranceTest]
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()


'If no items selected in listbox, exit sub
    If Me.LetList.ItemsSelected.Count = 0 Then
       MsgBox "You must make a selection(s) from the list", , "Selection Required !"
      Exit Sub
    End If
    
    'select all employees from query
    strSQL = "SELECT * FROM qrySeveranceLetters"
    
           
    'Build the IN string by looping through the listbox
    For i = 0 To LetList.ListCount - 1
        If LetList.Selected(i) Then
            If LetList.Column(0, i) = "All" Then
                flgSelectAll = True
            End If
            strIN = strIN & "'" & LetList.Column(0, i) & "',"
        End If
    Next i
    
    'Create the WHERE string, and strip off the last comma of the IN string
    strWhere = " WHERE [EID] in " & _
               "(" & Left(strIN, Len(strIN) - 1) & ")"

    'If "All" was selected in the listbox, don't add the WHERE condition
    If Not flgSelectAll Then
        strSQL = strSQL & strWhere
    End If

    MyDB.QueryDefs.Delete "qrySeveranceLetters2"
    Set qdef = MyDB.CreateQueryDef("qrySeveranceLetters2", strSQL)
    DoCmd.OpenQuery "qrySeveranceLetters3"
    
      If strList = "Severance Test" Then
        Set ObjWord = GetObject("\\C\Severance.docx", "Word.Document")
        ObjWord.Application.Visible = True
        ObjWord.MailMerge.OpenDataSource _
        Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
        SQLStatement:="SELECT * FROM [tblSeveranceLetters]"
        ObjWord.MailMerge.Execute
        ObjWord.Close SaveChanges:=False 



I would like to incorporate this code for MS Word that I found into mine so I can export each mail merge record to a PDF and WORD document. Here is the code I would like to incorporate but don't know how. Any assistance is greatly appreciated.

CODE --> VBA

Application.ScreenUpdating = False
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
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("Last_Name")) = "" Then Exit For
        'StrFolder = .DataFields("Folder") & Application.PathSeparator
        StrName = .DataFields("First_Name") & "_" & .DataFields("Last_Name")
      End With
      .Execute Pause:=False
    End With
      For j = 1 To Len(StrNoChr)
        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
      Next
    StrName = Trim(StrName)
    With ActiveDocument
      .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 

RE: Mail Merge from Table Saving each record to Word and PDF

(OP)
I have this saving each record in tblSeveranceLetters to a word doc using Last Name but it only runs once. I get an error message that the database has been placed in a state by user Admin that prevents it from being opened or locked. Any ideas what I am doing wrong?

CODE --> VBA

Private Sub Severance_DblClick(Cancel As Integer)
Dim currentDbName As String
Dim strList As String
Dim ObjWord As Word.Document
DoCmd.SetWarnings False
strList = Forms![frmSeverance]![TestList]

If strList = "Severance Test" Then
Set ObjWord = GetObject("\\C\Severance.docx", "Word.Document")
ObjWord.Application.Visible = True
ObjWord.MailMerge.OpenDataSource _
Name:=currentDbName, LinkToSource:=True, Connection:="DSN=MS Access Database;" & "DBQ=" & CurrentDb.Name & ";", _
SQLStatement:="SELECT * FROM [tblSeveranceLetters]"

Dim rec, LastRecord As Integer
Dim docNameField, strDocName, savePath As String
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord
LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
        If MsgBox(LastRecord & " documents will be created based on your Mail Merge template.", vbOKCancel) = vbOK Then
            savePath = "C:\completed\"
            docNameField = ("Last_Name")
        For rec = ActiveDocument.MailMerge.DataSource.FirstRecord To LastRecord
            ActiveDocument.MailMerge.DataSource.ActiveRecord = rec
            strDocName = ActiveDocument.MailMerge.DataSource.DataFields(docNameField).Value & ".docx"
        With ActiveDocument.MailMerge
            .Destination = wdSendToNewDocument
            .Execute
        End With
            ActiveDocument.SaveAs Filename:=savePath & strDocName
            ActiveDocument.Close False
            ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
        Next rec
        Else
        Exit Sub
        End If
                        
        ObjWord.Close SaveChanges:=False
        DoCmd.SetWarnings True 

RE: Mail Merge from Table Saving each record to Word and PDF

I haven't done mailmerge so not sure if there are other issues related to that.

Here is a snippet of code that I use at the point where it saves the word doc and then exports as PDF. It looks similar to what you have.

CODE -->

'Due to fake readonly issue, save as then reopen
'in order to be able to print to pdf
    stPDFName = sSavePath & InsertText & " " & stExtractTitle & ".docx"
    worddoc.SaveAs stPDFName
    worddoc.Close False

    Set worddoc = WordApp.Documents.Open(stPDFName)
    'Print the document as a PDF    
    worddoc.ExportAsFixedFormat Replace(stPDFName, ".docx", ".pdf"), 17 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close