Error with mail merge?

D

Damon

Hi,

I have written a class module which merges data into a word XP document, the datasource for this is usually a word document but I have changed that to a Excel spreadsheet. I can get it to work until it gets to the mailmerge.execute and then it comes up with "5631 Word could not merge the main document with the data source because the data records were empty or no data records matched your query options". Here is part of my code, any help on this would be greatly appreciated.

Public Sub printmerge(getfields() As String)
On Error GoTo Err_printmerge

Dim wrdSelection As Word.Selection
Dim wrdMailMerge As Word.MailMerge
Dim wrdMergeFields As Word.MailMergeFields
Dim StrToAdd As String
Dim curdoc As Word.Document
Dim strtemp As String

Screen.MousePointer = vbHourglass

strtemp = wrdApp.Options.DefaultFilePath(wdDocumentsPath)
wrdApp.Options.DefaultFilePath(wdDocumentsPath) = "C:\Program Files\NLSS\docs\merge_data"


' Get a Document
Set wrdDoc = wrdApp.Documents.Open(wrdDocName)
Set wrdSelection = wrdApp.Selection
Set wrdMailMerge = wrdDoc.MailMerge

' --- Perform MAIL MERGE --- '
' Create MailMerge Data file
CreateMailMergeDataFile getfields
wrdMailMerge.Execute True (This is where it falls over)

'Selects number of copies to print
wrdApp.ActiveDocument.PrintOut False, , , , , , , NoCopies
'Close the original form Document
wrdDoc.Close False

'close all documents in our instance of word
With wrdApp
For Each curdoc In .Documents
curdoc.Close False
Next curdoc
End With

wrdApp.Options.DefaultFilePath(wdDocumentsPath) = strtemp

Set wrdSelection = Nothing
Set wrdMailMerge = Nothing
Set wrdMergeFields = Nothing
Set wrdDoc = Nothing
Set curdoc = Nothing

Screen.MousePointer = vbDefault

Exit_printmerge:
Exit Sub
Err_printmerge:
MsgBox Err.Number & " " & Err.Description
Resume Exit_printmerge
End Sub

Private Sub CreateMailMergeDataFile(getfields() As String)
On Error GoTo Err_CreateMailMergeDataFile

Dim wrdDataDoc As excel.Workbook

' Open a data source at mergedoc containing the field data
wrdDoc.MailMerge.OpenDataSource name:=wrdDataDocName

' Open the file to insert data
Set wrdDataDoc = excel.Workbooks.Open(wrdDataDocName)

' Fill in the data
FillRow wrdDataDoc, getfields

Exit_CreateMailMergeDataFile:
Exit Sub
Err_CreateMailMergeDataFile:
MsgBox Err.Number & " " & Err.Description
Resume Exit_CreateMailMergeDataFile
End Sub

Private Sub FillRow(Doc As excel.Workbook, getfields() As String)
Dim i As Integer
Dim arraysize As Long
Dim Excelws As excel.Worksheet

Set Excelws = Doc.Worksheets("Sheet1")

arraysize = UBound(getfields)

For i = 0 To arraysize
With Excelws
.Cells(2, i + 1).Value = getfields(i)
End With
Next i

End Sub


Thanks

Damon
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top