Access 2002 database that will no longer properly pull data over when doing a mail merge to Word 2003.

Posted on 2014-08-28
Last Modified: 2016-06-15
The user is running Access 2002 on an XP machine. When trying to do a mail merge, we can edit the recipient list and select some of the records....even if we select individual records, the mail merge tries to pull all 8,000+ records.
The database was open when a power outage occurred and since the outage it hasn't worked. We have compacted  and repaired the database, cleared out temp files, and rebooted everything to no avail.
Question by:jhaysbns
    LVL 44

    Expert Comment

    have you deleted the .LDB file?
    LVL 31

    Accepted Solution

    Try this code (it works in Office 2003).  It uses a different method, creating a text file for the merge instead of a live link, so it isn't nearly as memory-intensive:

    Private Sub cmdCreateDocuments_Click()
    'Created by Helen Feddema 30-May-2014
    'Last modified by Helen Feddema 18-Jul-2014
    On Error GoTo ErrorHandler
       Dim appWord As Word.Application
       Dim cbo As Access.ComboBox
       Dim doc As Word.Document
       Dim docMerge As Word.Document
       Dim fil As Scripting.File
       Dim fso As New Scripting.FileSystemObject
       Dim i As String
       Dim intCount As Integer
       Dim intDocCount As Integer
       Dim intReturn As Integer
       Dim intSaveNameFail As String
       Dim lngContactID As Long
       Dim lngRecordCount As Long
       Dim lngSelectCount As Long
       Dim rstMerge As DAO.Recordset
       Dim rstSource As DAO.Recordset
       Dim strAddress As String
       Dim strBookmark As String
       Dim strCompanyName As String
       Dim strContactName As String
       Dim strContactNameAndJob As String
       Dim strCountry As String
       Dim strDBPath As String
       Dim strDefaultDocsPath As String
       Dim strDefaultTemplatesPath As String
       Dim strDocsPath As String
       Dim strDocType As String
       Dim strJobTitle As String
       Dim strLongDate As String
       Dim strPhone As String
       Dim strProgressBarText As String
       Dim strQuery As String
       Dim strRecordSource As String
       Dim strSalutation As String
       Dim strSaveName As String
       Dim strSaveNamePath As String
       Dim strShortDate As String
       Dim strTemplateName As String
       Dim strTemplateNameAndPath As String
       Dim strTemplatesPath As String
       Dim strTest As String
       Dim strTestFile As String
       Dim strTextFile As String
    On Error Resume Next
       'Delete old merge data text file, if it exists
       strDBPath = Application.CurrentProject.Path & "\"
       strTextFile = strDBPath & "Merge Data.txt"
      'Debug.Print "Text file for merge: " & strTextFile
       Set fil = fso.GetFile(strTextFile)
    On Error GoTo ErrorHandler
       If Not (fil Is Nothing) Then
       End If
       DoCmd.SetWarnings False
       'Check that a template has been selected
       Set cbo = Me![cboSelectDocument]
       strTemplateName = Nz(cbo.Value)
       If strTemplateName = "" Then
          strTitle = "No template selected"
          strPrompt = "Please select a template"
          MsgBox prompt:=strPrompt, _
             buttons:=vbInformation + vbOKOnly, _
          GoTo ErrorHandlerExit
          Debug.Print "Template: " & strTemplateName
          strDocType = cbo.Column(1)
       End If
       strFilter = GetProperty("Filter", "")
       lngRecordCount = Nz(DCount("*", "qryMergeContacts"))
       'Check that a document has been selected
       Set cbo = Me![cboSelectDocument]
       strTemplateName = Nz(cbo.Column(0))
      'Debug.Print "Template: " & strTemplateName
       strFilter = GetProperty("Filter", "")
       lngRecordCount = Nz(DCount("*", "qryMergeContacts"))
       If strTemplateName = "" Then
          strTitle = "No document selected"
          strPrompt = "Please select a document"
          MsgBox prompt:=strPrompt, _
             buttons:=vbInformation + vbOKOnly, _
          GoTo ErrorHandlerExit
       ElseIf strFilter = " " Then
          strTitle = "Question"
          strPrompt = "Create a merge document for all " & lngRecordCount _
             & " contacts?"
          intReturn = MsgBox(prompt:=strPrompt, _
             buttons:=vbQuestion + vbYesNo, _
          If intReturn = vbNo Then
             GoTo ErrorHandlerExit
          ElseIf intReturn = vbYes Then
             DoCmd.CopyObject newname:="qfltMergeContacts", _
                sourceobjecttype:=acQuery, _
          End If
       End If
       'Set Word application variable; if Word is not running,
       'the error handler defaults to CreateObject
       Set appWord = GetObject(, "Word.Application")
       strLongDate = Format(Date, "mmmm d, yyyy")
       strShortDate = Format(Date, "m-d-yyyy")
       'Get selected Docs and Templates paths from database properties
       '(saved from controls on main menu)
       strDocsPath = GetDocsPath
       strTemplatesPath = GetTemplatesPath
       strTemplateNameAndPath = strTemplatesPath & strTemplateName
      'Debug.Print "Template name and path: " & strTemplateNameAndPath
       'Check for existence of template in templates folder,
       'and exit if not found
    On Error Resume Next
       Set fil = fso.GetFile(strTemplateNameAndPath)
       If fil Is Nothing Then
          strTitle = "Template not found"
          strPrompt = "Can't find " & strTemplateName & " in " _
             & strTemplatesPath & "; canceling"
          MsgBox prompt:=strPrompt, _
             buttons:=vbInformation + vbOKOnly, _
          GoTo ErrorHandlerExit
       End If
    On Error GoTo ErrorHandler
       strTitle = "Information missing"
       strQuery = "qfltMergeContacts"
       Set rstSource = CurrentDb.OpenRecordset(strQuery)
       lngSelectCount = rstSource.RecordCount
       If lngSelectCount = 0 Then
          strTitle = "No records found"
          strPrompt = "Please select another filter"
          MsgBox prompt:=strPrompt, _
             buttons:=vbInformation + vbOKOnly, _
          GoTo ErrorHandlerExit
          strProgressBarText = "Creating merge document... "
          Call SysCmd(acSysCmdInitMeter, strProgressBarText, _
       End If
       'Clear tblMergeList and set up recordset based on it
       strTable = "tblMergeList"
       strSQL = "DELETE tblMergeList.* FROM tblMergeList;"
       DoCmd.SetWarnings False
       DoCmd.RunSQL strSQL
      'Debug.Print "Opening recordset based on " & strTable
       Set rstMerge = CurrentDb.OpenRecordset(strTable, dbOpenTable)
       lngRecordCount = 0
       Do While Not rstSource.EOF
          lngContactID = rstSource![ContactID]
         'Debug.Print "On Contact ID: " & lngContactID
          'Set variables with data from different fields
          strContactName = Nz(rstSource![FirstName]) & _
             " " & Nz(rstSource![LastName])
          strJobTitle = Nz(rstSource![JobTitle])
          strCompanyName = Nz(rstSource![CompanyName])
          strPhone = Nz(rstSource![WorkPhone])
          strSalutation = Nz(rstSource![Salutation])
          strAddress = Nz(rstSource![StreetAddress]) & vbCrLf & _
             Nz(rstSource![City]) & ", " & _
             Nz(rstSource![StateOrProvince]) & _
             "  " & Nz(rstSource![PostalCode])
          'Write data from variables to a new record in table
          With rstMerge
             ![Name] = strContactName
             ![JobTitle] = strJobTitle
             ![CompanyName] = strCompanyName
             ![Address] = strAddress
             ![Salutation] = strSalutation
             ![TodayDate] = strLongDate
          End With
          lngRecordCount = lngRecordCount + 1
          Debug.Print "Updating progress bar for record " _
             & lngRecordCount & " of "; lngSelectCount & " records"
          Call SysCmd(acSysCmdUpdateMeter, lngRecordCount)
       'Export merge list to a text file (to avoid having to open the
       'database when the document is opened later on)
       DoCmd.TransferText transfertype:=acExportDelim, _
          TableName:=strTable, _
          FileName:=strTextFile, _
       'Open a new merge document based on the selected template
       Set doc = appWord.Documents.Add(strTemplateNameAndPath)
      'Debug.Print "New merge doc name: " & doc.Name
       'Check for existence of previously saved letter in documents folder,
       'and append an incremented number to save name if found
       strSaveName = strDocType & " on " & strShortDate & ".doc"
       i = 2
       intSaveNameFail = True
       Do While intSaveNameFail
          strSaveNamePath = strDocsPath & strSaveName
         'Debug.Print "Proposed save name and path: " _
             & vbCrLf & strSaveNamePath
          strTestFile = Nz(Dir(strSaveNamePath))
         'Debug.Print "Test file: " & strTestFile
          If strTestFile = strSaveName Then
            'Debug.Print "Save name already used: " & strSaveName
             'Create new save name with incremented number
             intSaveNameFail = True
             strSaveName = strDocType & " " & CStr(i) _
                & " on " & strShortDate & ".doc"
             strSaveNamePath = strDocsPath & strSaveName
            'Debug.Print "New save name and path: " _
                & vbCrLf & strSaveNamePath
             i = i + 1
            'Debug.Print "Save name not used: " & strSaveName
             intSaveNameFail = False
          End If
      'Debug.Print "Final save name: " & strSaveNamePath
       'Set the merge data source to the text file just created,
       'and do the merge
       With doc
          .MailMerge.OpenDataSource Name:=strTextFile, _
          If Nz(InStr(strTemplateName, "Label")) > 0 Then
             .MailMerge.MainDocumentType = wdMailingLabels
             .MailMerge.MainDocumentType = wdFormLetters
          End If
          .MailMerge.Destination = wdSendToNewDocument
          'Set another Document variable to the newly merged document,
          'to ensure that the correct document is saved
          Set docMerge = appWord.ActiveDocument
          .Close savechanges:=wdDoNotSaveChanges
       End With
       docMerge.SaveAs strSaveNamePath
       If lngSelectCount = 1 Then
          strPrompt = strDocType & " created for 1 contact"
          strPrompt = strDocType & " created for " _
             & lngSelectCount & " contacts"
       End If
       MsgBox prompt:=strPrompt, _
          buttons:=vbInformation + vbOKOnly, _
       Call SysCmd(acSysCmdRemoveMeter)
       Call BringDocToFront(appWord, docMerge)
       Set appWord = Nothing
       Exit Sub
       If Err = 429 Then
          'Word is not running; open Word with CreateObject
          Set appWord = CreateObject("Word.Application")
          Resume Next
          MsgBox "Error No: " & Err.Number & "; Description: " _
             & Err.Description
          Resume ErrorHandlerExit
       End If
    End Sub

    Open in new window

    This is from the Access 2003 sample database for my Working with Word ebook.

    Author Comment

    I have deleted the .LDB file and that didn't seem to help.

    I'll give the code a shot later today when the  client calls back and let's me on the computer.
    LVL 26

    Expert Comment

    No comment has been added to this question in more than 21 days, so it is now classified as abandoned.

    I have recommended this question be closed as follows:

    Accept: Helen_Feddema (https:#a40293139)

    If you feel this question should be closed differently, post an objection and the moderators will review all objections and close it as they feel fit. If no one objects, this question will be closed automatically the way described above.

    Experts-Exchange Cleanup Volunteer

    Featured Post

    Enabling OSINT in Activity Based Intelligence

    Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

    Join & Write a Comment

    Outline Suppose you have some simple text based data in Excel that you would like to display as a PowerPoint presentation. Of course it would be possible to write some fairly complex VBA code that created a new slide for each line of the Excel data…
    Meetings to discuss business process can waste time, and often do .  The meeting's dialog can get confusing when participants have different professional perspectives and backgrounds.  A jointly-developed process picture helps wade through the confu…
    The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
    XMind Plus helps organize all details/aspects of any project from large to small in an orderly and concise manner. If you are working on a complex project, use this micro tutorial to show you how to make a basic flow chart. The software is free when…

    729 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    21 Experts available now in Live!

    Get 1:1 Help Now