Send a Delivery Status Notification - from access

[mel_palmeruk]

Hi

I am trying to use the floowing code suppied by microsoft at this url

http://support.microsoft.com/default.aspx?scid=kb;en-us;Q302839

to get a delivery status notification for emails that I am sending via
my acces app that I have set up.

I have the following code: Which basically selects a list of emails
from a table which will be used to send the emails to. I also want a
delivery status notification however. EVERYTHING works until I try and
use the last few line of this code. The lines
.DSNOptions = cdoDSNSuccessFailOrDelay
.DSNOptions = 14

Firstly access does not know about the variable
cdoDSNSuccessFailOrDelay if i comment out that line - the code works
with no errors - however no emails get sent.

HERE IS THE CODE THAT I HAVE
----
Private Sub cmdEmail_Click()
On Error GoTo Err_cmdEmail_Click

Dim txtSubject As String
Dim txtAttachement As String
Dim txtCover As String
Dim txtEmail As String

txtEmail = "(e-mail address removed)"
txtSubject = Me.txtSubject
txtCover = Me.txtBody
txtAttachement = "E:\2005\March\Melissa_CV_May2005.doc"

MsgBox "Sending Email"

Dim stSql As String
Dim rst As Recordset

stSql = " SELECT testingemail.Name, testingemail.Email "
stSql = stSql & " FROM testingemail;"

Set rst = CurrentDb.OpenRecordset(stSql)

If Not rst.EOF Then rst.MoveFirst
Do While Not (rst.EOF)
txtEmail = txtEmail & "; " & rst!Email
rst.MoveNext
Loop

rst.Close

Call Message(txtEmail, txtSubject, txtCover, txtAttachement)

MsgBox "Email Sent Successfully"
Exit_cmdEmail_Click:
Exit Sub

Err_cmdEmail_Click:
MsgBox Err.Description
Resume Exit_cmdEmail_Click

End Sub

Private Sub Message(theAddress As String, thesubject As String, theBody
As String, theAttachment As String)
' This example use late binding, you don't have to set a reference
' You must be online when you run the sub
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Dim emailAddress As String
Dim contractorName As String
Dim fromAddress As String

Const cdoDSNSuccessFailOrDelay = 14

Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds

..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
Me.smtpAddress

'.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")
= 25

..Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")
= 1

..Item("http://schemas.microsoft.com/cdo/configuration/sendusername") =
Me.username

..Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") =
Me.password

.Update
End With

emailAddress = Me.fromAddress
contractorName = Me.fromName

fromAddress = """" & contractorName & """ <" & emailAddress & ">"

' MsgBox "emailAddress " & emailAddress
' MsgBox "fromAddress " & fromAddress


Set iMsg = CreateObject("CDO.Message")

With iMsg
Set .Configuration = iConf
.To = theAddress
.FROM = fromAddress
.Subject = thesubject
.TextBody = theBody
.Fields("urn:schemas:mailheader:disposition-notification-to")
= fromAddress
.Fields("urn:schemas:mailheader:return-receipt-to") =
fromAddress

Dim attachements, i
If theAttachment <> "" Then
attachements = Split(theAttachment, ";")
For i = 0 To UBound(attachements)
.AddAttachment attachements(i)
Next
End If

'Set DSN options.
' Name Value Description
' cdoDSNDefault 0 No DSN commands are issued.
' cdoDSNNever 1 No DSN commands are issued.
' cdoDSNFailure 2 Return a DSN if delivery fails.
' cdoDSNSuccess 4 Return a DSN if delivery
succeeds.
' cdoDSNDelay 8 Return a DSN if delivery is
delayed.
' cdoDSNSuccessFailOrDelay 14 Return a DSN if delivery
succeeds, fails, or is delayed.

'.DSNOptions = cdoDSNSuccessFailOrDelay
.DSNOptions = 14

.Fields.Update
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing

End Sub

 

[mel_palmeruk]

Anyone out there got any ideas??
Please some help would be greatly appriciated.