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

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.
jhaysbnsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
have you deleted the .LDB file?
0
Helen FeddemaCommented:
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
      fil.Delete
   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, _
         Title:=strTitle
      cbo.SetFocus
      cbo.Dropdown
      GoTo ErrorHandlerExit
   Else
      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, _
         Title:=strTitle
      cbo.SetFocus
      cbo.Dropdown
      GoTo ErrorHandlerExit
   ElseIf strFilter = " " Then
      strTitle = "Question"
      strPrompt = "Create a merge document for all " & lngRecordCount _
         & " contacts?"
      intReturn = MsgBox(prompt:=strPrompt, _
         buttons:=vbQuestion + vbYesNo, _
         Title:=strTitle)
      If intReturn = vbNo Then
         GoTo ErrorHandlerExit
      ElseIf intReturn = vbYes Then
         DoCmd.CopyObject newname:="qfltMergeContacts", _
            sourceobjecttype:=acQuery, _
            sourceobjectname:="qryMergeContacts"
      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, _
         Title:=strTitle
      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, _
         Title:=strTitle
      GoTo ErrorHandlerExit
   Else
      strProgressBarText = "Creating merge document... "
      Call SysCmd(acSysCmdInitMeter, strProgressBarText, _
         lngSelectCount)
   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
         .AddNew
         ![Name] = strContactName
         ![JobTitle] = strJobTitle
         ![CompanyName] = strCompanyName
         ![Address] = strAddress
         ![Salutation] = strSalutation
         ![TodayDate] = strLongDate
         .Update
      End With
         
      lngRecordCount = lngRecordCount + 1
      Debug.Print "Updating progress bar for record " _
         & lngRecordCount & " of "; lngSelectCount & " records"
      Call SysCmd(acSysCmdUpdateMeter, lngRecordCount)

NextContact:
      rstSource.MoveNext
   Loop
   
   rstSource.Close
   rstMerge.Close
   
   '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, _
      HasFieldNames:=True
   
   '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
      Else
        'Debug.Print "Save name not used: " & strSaveName
         intSaveNameFail = False
      End If
   Loop
   
  '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, _
         Format:=wdOpenFormatText
      
      If Nz(InStr(strTemplateName, "Label")) > 0 Then
         .MailMerge.MainDocumentType = wdMailingLabels
      Else
         .MailMerge.MainDocumentType = wdFormLetters
      End If
      
      .MailMerge.Destination = wdSendToNewDocument
      .MailMerge.Execute
      
      '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"
   Else
      strPrompt = strDocType & " created for " _
         & lngSelectCount & " contacts"
   End If
   
   MsgBox prompt:=strPrompt, _
      buttons:=vbInformation + vbOKOnly, _
      Title:=strTitle

   Call SysCmd(acSysCmdRemoveMeter)
   Call BringDocToFront(appWord, docMerge)
      
ErrorHandlerExit:
   Set appWord = Nothing
   Exit Sub

ErrorHandler:
   If Err = 429 Then
      'Word is not running; open Word with CreateObject
      Set appWord = CreateObject("Word.Application")
      Resume Next
   Else
      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.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jhaysbnsAuthor Commented:
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.
0
MacroShadowCommented:
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.

MacroShadow
Experts-Exchange Cleanup Volunteer
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.