CDO-email

[Filips Benoit]

Dear All,

Since 2 months we use CDO to send emails using function below.
All is Ok but occasionally emails are NOT send without any error-message.
For that reason i inserted a check ( AddEmail2Log and DoCmd.RunSQL ...) to
log emailsending and store success or failure.
Since insert log i haven't seen any failure.

But maybe you can see a week point in my code !
Maybe there is a better newsgroup to ask this question but i can't find it.

thanks,

Filip

-------------------------------------------------------------------------------------------------------------------------------
Public Function SendCDOemail(Optional ToAddres As Variant, Optional
FromAddres As Variant, _
Optional CCAddres As Variant, Optional Subject As Variant, _
Optional MessageText As Variant, Optional Attachment1Path As Variant,
Optional strFromForm As Variant) As Boolean
' set references to Microsoft Scripting Runtime AND Microsoft Office
12.0 Object Library
On Error GoTo ErrorMsgs

Dim iNewEmailLogID As Long
Dim objMessage As Object
Set objMessage = CreateObject("CDO.Message")
SendCDOemail = False

'store email attempt in log
iNewEmailLogID = AddEmail2Log(Now(), strFromForm, "CDO", False,
ToAddres, "", "", "", "", "")

If Not IsMissing(ToAddres) Then
objMessage.To = ToAddres
End If
If Not IsMissing(FromAddres) Then
objMessage.FROM = FromAddres
End If
If Not IsMissing(CCAddres) Then
objMessage.CC = CCAddres
End If
If Not IsMissing(Subject) Then
objMessage.Subject = Subject
End If
If Not IsMissing(MessageText) Then
objMessage.TextBody = MessageText
End If
If Not IsMissing(Attachment1Path) Then
objMessage.AddAttachment Attachment1Path
End If

objMessage.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver")
= "uit.telenet.be"
objMessage.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing")
= 2
objMessage.Configuration.Fields.Update
objMessage.Send
Set objMessage = Nothing

SendCDOemail = True

' note success
DoCmd.RunSQL "UPDATE TBL_EMAIL_LOG SET TBL_EMAIL_LOG.EMAIL_SEND_OK =
True WHERE (((TBL_EMAIL_LOG.EMAIL_SEND_ID)=" & iNewEmailLogID & "));"


Exit Function

ErrorMsgs:
MsgBox "SendCDOemail" & Chr(13) & Err.Number & " " & Err.Description
SendCDOemail = False
End Function