[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 461
  • Last Modified:

Using a Word template in Mail merge with Access table.

Is it possible to use a word template in creating mailmerge documnet? I would like to protect the design of the word document as to prevent alteration, but somehow I  need some code and directin to proceed.
I have a continous form in an access database which a user is entering name and address information.
I would like to merge it to a word application/documents that would open a document from a template.
Can an Expert show me how to add the template behid  a button and automate the process.
0
zachvaldez
Asked:
zachvaldez
  • 3
  • 3
1 Solution
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
<<Can an Expert show me how to add the template behid  a button and automate the process.>>

  Got a sample database with code that shows you how to do this.  Drop me a line at jimdettman"@"earthlink.net and I'll send it along.

  The sample database does a merge with the Word docs by poking data into the word doc which has pre-defined bookmarked postions.  A series of tables on the Access side describes the data source, what data is to be poked, and which book mark it is to be poked to.

  Come back to this thread with any questions or comments.  Do not use e-mail to discuss the sample database.

JimD
0
 
zachvaldezAuthor Commented:
Can you post the solution here rather than contacting outside the forum? thanks
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:
<<Can you post the solution here rather than contacting outside the forum? thanks>>

  No.  It's a working database with quite a bit of code and a couple of forms.  It's not postable.

JimD
0
Free Backup Tool for VMware and Hyper-V

Restore full virtual machine or individual guest files from 19 common file systems directly from the backup file. Schedule VM backups with PowerShell scripts. Set desired time, lean back and let the script to notify you via email upon completion.  

 
zachvaldezAuthor Commented:
If you can just provide the main points, that' would be excellent!
0
 
Jim Dettman (Microsoft MVP/ EE MVE)PresidentCommented:

  A couple of tables describe a merge template.  This template is the data source, fields to be pulled, where they should be poked to in the word doc, and some attributes for the poked data (ie. font, bold, etc).  There are a couple of forms that manage these tables.

  What does all the work is the main merge code, which I've posted below.  You'd call this from a form (also in the sample DB I give out) to perform the merge.

JimD

Function AutomateWord(ByVal varMergeName As Variant, ByVal strProcessFlag As String, Optional ByVal fDestroyObject As Variant) As Integer
    ' Purpose:
    '     Based on the data stored in tblAuto, tblAutoFields, and tblAutoParams,
    '     this function use Automation to control Word,
    '     It inserts data into a document (varWordDoc) and prints the document.
    '     This is completely driven by the tblAuto, tblAutoFields, and tblAutoParams tables.
    '     (This function was originally written to use DDE.)
    ' In:
    '     varWordDoc  = name of Word document
    '     fOneRec = use first record only, even if multiple records in query
    '     fDestroyObject = set object variable to Nothing when done
    ' Out:
    '     Return value: True if successful; False if failure
    ' History:
    '     Created 11/10/94 pel; Last Modified 04/20/97 pel
    '     Updated 03/10/98 Jrd - Added tblAutoParams and new arguments.
    '     Updated 05/29/98 JRD - Forced word to not background print.
    '                            If background printing on, timing issues resulted.
    '     Updated 07/10/01 JRD - Updated for A97 and convert to early binding for
    '                            performance. Is no longer backward compatible with

   
    On Error GoTo AutomateWordErr

    Dim db As Database
    Dim rstHeader As Recordset
    Dim rstFields As Recordset
    Dim rstParams As Recordset
    Dim rstData As Recordset
    Dim varWordDocName As Variant
    Dim varQueryName As Variant
    Dim prmName As Parameter
    Dim qdfData As QueryDef
    Dim varDocAndPath As Variant
    Dim varPreprocessFunction As Variant
    Dim varQueryParameter As Variant
    Dim varSendFields As Variant
    Dim varDocPrint As Variant
    Dim varDocMacroPrint As Variant
    Dim varCopies As Variant
    Dim varReturn As Variant
    Dim intI As Integer
    Dim intJ As Integer
    Dim fOneRec As Integer
    Dim avarFields As Variant
    Dim intFieldsRecLim As Integer

    Const strProc = "AutomateWord"
    Const pelMaxFields = 25
    Const pelQuote = """"
   
    Const pelFldWWBookmark = 0
    Const pelFldAccessField = 1
    Const pelFldWWFont = 2
    Const pelFldWWPoints = 3
    Const pelFldWWBold = 4
    Const pelFldWWItalics = 5
    Const pelFldWWUnderline = 6
    Const pelWordMacroRun = 1
    Const pelWordFileCloseNoSave = 2
   
    ' Set process options
    Select Case strProcessFlag
   
    Case "P"
        ' If preview mode.
        fOneRec = True
        varDocPrint = False
    Case "T"
        ' Test print
        fOneRec = True
        varDocPrint = True
    Case Else
        ' Assume normal print
        fOneRec = False
        varDocPrint = True
    End Select
   
    ' Should we get rid of the object at the end?
    If IsMissing(fDestroyObject) Then fDestroyObject = True
    AutomateWord = False
   
    Set db = CurrentDb()
    Set rstHeader = db.OpenRecordset("select * from tblAutoHeader where [MergeName] = " & pelQuote & varMergeName & pelQuote, dbOpenSnapshot, dbForwardOnly)

    If rstHeader.RecordCount < 1 Then
        MsgBox "Can't continue because tblAutoHeader record not found.", vbCritical + vbOKOnly, strProc
        GoTo AutomateWordDone
    End If

    ' Grab information from header record
    varWordDocName = rstHeader!WWDocument
    varQueryName = rstHeader!QueryName
    varPreprocessFunction = rstHeader!PreProcessFunction
    varSendFields = rstHeader!SendFields
    varDocMacroPrint = rstHeader!DocMacroPrint
    varCopies = rstHeader!DocCopies
    rstHeader.Close
   
    ' Perform pre-process function if required
    If Not IsNull(varPreprocessFunction) Then
        varReturn = Eval(varPreprocessFunction)
        If Not varReturn Then
            MsgBox "Cannot continue because preprocess failed.", vbCritical + vbOKOnly, strProc
            GoTo AutomateWordDone
        End If
    End If
   
    ' Grab field information
    Set rstFields = db.OpenRecordset("Select WWBookmark, AccessField, WWFont, WWPoints, WWBold, WWItalics, WWUnderline From tblAutoFields Where [MergeName] = " & pelQuote & varMergeName & pelQuote, dbOpenSnapshot)
   
    If rstFields.RecordCount < 1 Then
        MsgBox "Error: no tblAutoFields records were found.", vbCritical + vbOKOnly, strProc
        GoTo AutomateWordDone
    End If
   
    ' Use GetRows method to fill avarFields array
    ' with the records from tblAutoFields
    avarFields = rstFields.GetRows(pelMaxFields)
    intFieldsRecLim = UBound(avarFields, 2) + 1
   
    rstFields.Close
    Set rstFields = Nothing
   
    If intFieldsRecLim = pelMaxFields Then
        MsgBox "Warning: maximum number of fields reached.", vbInformation + vbOKOnly, strProc
    End If
   
    ' Begin Automation conversation with Word
    ' Don't need to intialize mobjWord if it already points to Word
    If mobjWord Is Nothing Then
        On Error Resume Next
        Set mobjWord = GetObject(, "Word.Application")
        If Err <> 0 Then
            Err = 0
            Set mobjWord = CreateObject("Word.Application")
        End If
        If Err <> 0 Then
            MsgBox "Error: Word Automation object could not be created.", vbCritical + vbOKOnly, strProc
            GoTo AutomateWordDone
        End If
        On Error GoTo AutomateWordErr
    End If
   
    ' Make sure background printing is turned off.
    mobjWord.WordBasic.ToolsOptionsPrint , , , , , , , , , 0
   
    ' Open querydef and set parameters if necessary.
    Set qdfData = db.QueryDefs(varQueryName)
    Set rstParams = db.OpenRecordset("Select * From tblAutoParams Where [MergeName] = " & pelQuote & varMergeName & pelQuote, dbOpenSnapshot)
   
    For intI = 0 To qdfData.PARAMETERS.Count - 1
        Set prmName = qdfData.PARAMETERS(intI)
        rstParams.FindFirst "MergeName = '" & varMergeName & "' AND ParamName = '" & prmName.Name & "'"
        If rstParams.NoMatch Then
            MsgBox "Can't continue because value for parameter '" & prmName.Name & "' is not in tblAutoParams.", vbCritical + vbOKOnly, strProc
            GoTo AutomateWordDone
        Else
            prmName.Value = Eval(rstParams![ParamValue])
        End If
    Next intI
    rstParams.Close
    Set rstParams = Nothing

    ' Create data recordset
    Set rstData = qdfData.OpenRecordset(dbOpenSnapshot, dbForwardOnly)

    If rstData.RecordCount < 1 Then
        MsgBox "Can't continue because no records returned by '" & varQueryName & "' query.", vbCritical + vbOKOnly, strProc
        GoTo AutomateWordDone
    End If

    ' Docment is located in current database directory.
    varDocAndPath = GetDBDir() & varWordDocName

    ' Create a new document for each data record.
    Do While Not rstData.EOF
        mobjWord.WordBasic.FileOpen varDocAndPath
   
        ' Send data, if any, over to document and format it
        If varSendFields Then
            ' Move through tblAutoFields row by row
            ' and send over data to document
            For intJ = 0 To intFieldsRecLim - 1
                ' Jump to bookmark
                mobjWord.Selection.GoTo What:=wdGoToBookmark, Name:=avarFields(pelFldWWBookmark, intJ)
                ' Format the font per field specification
                mobjWord.WordBasic.FormatFont avarFields(pelFldWWPoints, intJ), IIf(avarFields(pelFldWWUnderline, intJ), 1, 0), , , , , , , , , , , , , , avarFields(pelFldWWFont, intJ), IIf(avarFields(pelFldWWBold, intJ), 1, 0), IIf(avarFields(pelFldWWItalics, intJ), 1, 0)
                ' Insert the data at the bookmark
                mobjWord.WordBasic.INSERT pelNullToZLS(rstData(avarFields(pelFldAccessField, intJ)))
            Next intJ
        End If ' varSendFields

        Debug.Print "Loaded and formatted data for " & rstData.[Name]

        ' Print the document, if required
        ' Otherwise shift focus to document for user edit
        If varDocPrint Then
            ' Print the document if required
            ' Use a Print Macro if one has been specified
            DoEvents
            If IsNull(varDocMacroPrint) Then
                mobjWord.WordBasic.FilePrint , , , , , , , pelNullToZLS(varCopies)
            Else
                mobjWord.WordBasic.ToolsMacro varDocMacroPrint, pelWordMacroRun
            End If
            Debug.Print "Printed document"
        End If
           
        DoEvents
        DoEvents
        If varDocPrint Then
            mobjWord.WordBasic.FileClose pelWordFileCloseNoSave
            Debug.Print "Executed File Close"
            DoEvents
            DoEvents
        End If
       
        ' If requested as one record only,
        ' it's time to bail out!
        If fOneRec Then
            Exit Do
        Else
            rstData.MoveNext
        End If
   
    Loop
    rstData.Close
    Set rstData = Nothing
   
    If fOneRec And Not varDocPrint Then
        ' Now shift focus to Word
        mobjWord.WordBasic.AppShow
        AppActivate "Microsoft Word - " & varWordDocName
    Else
        AppActivate "Microsoft Access"
    End If

    AutomateWord = True

AutomateWordDone:
    On Error Resume Next
    If fDestroyObject Then Set mobjWord = Nothing
    If Not rstHeader Is Nothing Then rstHeader.Close
    If Not rstFields Is Nothing Then rstFields.Close
    If Not rstData Is Nothing Then rstData.Close
    If Not rstParams Is Nothing Then rstData.Close
    On Error GoTo 0
    Exit Function

AutomateWordErr:
    DoCmd.Hourglass False
    Select Case Err
    Case Else
        MsgBox "Error#" & Err & ": " & Error, vbCritical + vbOKOnly, "AutomateWord"
    End Select
    Resume AutomateWordDone

End Function
0
 
zachvaldezAuthor Commented:
thanks for posting such a long code. I really appreciate it!
0

Featured Post

Nothing ever in the clear!

This technical paper will help you implement VMware’s VM encryption as well as implement Veeam encryption which together will achieve the nothing ever in the clear goal. If a bad guy steals VMs, backups or traffic they get nothing.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now