MailMerge to Email incomplete

[marlou]

--------------------------------------------------------------
Applies to: Word 2002 (10.4219.4219) SP-2
Windows XP Professional 5.1.2600 SP-1 (Build 2600)

Goal: Word-template containing:
-UserForm
-MailMerge to Email
-Personalized hyperlink for each record

Problem: Not all records will be processed
--------------------------------------------------------------

What i've come up with so far is listed below.
- EventClassModule is created during Document_New().
- MailMerge-settings are made at the btnOK_Click of the userform.
- MailMergeBeforeRecordMerge inserts unique hyperlink for each record.
- MailMergeAfterMerge shows the results of the MailMerge.

After filling in the userform, users click the Merge-to-Email-button
in the MailMerge-taskbar. All options are preset (and correct),
so they only have to click OK.

In my testcases, all records contain email addresses, but only the
first two emails will be sent. The messagebox after the merge confirms
that only 2 of 5 have been sent.

When i comment the MailMergeBeforeRecordMerge then the MailMerge
will handle all records of the datasource, so the problem seems
to be in this code. Can't figure out what goes wrong though...

Thanks for your help!

Cheers,
Marlou


--------------------------------------------------------------
ThisDocument
--------------------------------------------------------------
Option Explicit
Dim x As New EventClassModule

Private Sub Document_New()
Set x.App = Word.Application
frmUitnodiging.Show
End Sub


--------------------------------------------------------------
UserForm
--------------------------------------------------------------
Private Sub btnOK_Click()
With ActiveDocument.MailMerge
.Destination = wdSendToEmail
.MailAddressFieldName = "EmailAddress"
.MailSubject = .DataSource.DataFields("ObjectName")
.MailFormat = wdMailFormatHTML
.SuppressBlankLines = True

With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
End With
End Sub


--------------------------------------------------------------
EventClassModule
--------------------------------------------------------------

Public WithEvents App As Word.Application
Public nCount As Long
Public nTotal As Long

Private Sub App_MailMergeAfterMerge(ByVal Doc As Document, ByVal DocResult
As Document)
Doc.MailMerge.DataSource.ActiveRecord = wdLastDataSourceRecord
nTotal = Doc.MailMerge.DataSource.ActiveRecord
Doc.MailMerge.DataSource.ActiveRecord = wdFirstDataSourceRecord
MsgBox "Total: " & CStr(nTotal) & vbCrLf & _
"Sent by email: " & CStr(nCount) & vbCrLf & _
"Not sent: " & CStr(nTotal - nCount), vbOKOnly
End Sub

Private Sub App_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As
Boolean)
Dim dt As String
Dim lt As String
Dim h As Hyperlink
Dim r As Range
Dim sUser As String

nCount = nCount + 1
Set r = Doc.Bookmarks("insertHyperlink").Range
r.Text = ""

If Doc.MailMerge.DataSource.DataFields("UserId") <> 0 Then
sUser = "User=" & Doc.MailMerge.DataSource.DataFields("UserId") & _
"&Type=P"
Else
sUser = "User=" &
Doc.MailMerge.DataSource.DataFields("CompanyUserId") & _
"&Type=O"
End If

lt = "http://www.test.com/applications/example/default.asp?Key=" & _
Doc.MailMerge.DataSource.DataFields("ObjectKey") & _
"&" & sUser & "&Name='" & _
Replace(Doc.MailMerge.DataSource.DataFields("ObjectName"), " ",
"%20") & "'"

dt = "click this"

Set h = Doc.Hyperlinks.Add(Anchor:=r, Address:=lt, TextToDisplay:=dt)
Doc.Bookmarks.Add Name:="insertHyperlink", Range:=h.Range

Set r = Nothing
Set h = Nothing
End Sub