Access - Sending Mail's

(This code certainly is VB6 compatible!)

wilhelm.moser@net.co.at  2004-07-30

 

download MailSend_with_AccessXP.zip ( 29 kb)

 

Abstract:

This article is a small Howto for Sending VBA-Code based Mail, including mass-mails! (Please do not abuse this functionality). One of the really annoying function's in MS-Access is

DoCmd.SendObject acSendNoObject, , "(*.txt)", strSendTo, , , strSubject, strMessage, False

as it is not really adoptable to the requirements of modern mailings. (i.e. attachments).

A lot of Applications do furthermore require the ability to send mail without the needs to install MS-Outlook or MS-Outlook Express. One might think it is a good idea to use the MAPI (Message Application Programmers Interface). Well yes but MAPI depends on some standardized MAPI-Message Client as MS-Outlook... So what if you distribute your Application to various Windows Platforms and you can not be sure that your Customer uses an MAPI compatible Client?

For this reasons Microsoft created the Collaborative Data Objects CDO 1.2.1.


Error:

If you are getting an Error like "The 'SendUsing' configuration value is invalid" on
debugging 

MailSend.send

Error:
    mError = Err.Description
    send = False

<>The cause is simple:
Postinstall the Windows smtp server via Control-Panel-Software ( in the IIS-Section)
Don't forget to restart MS-Access!


Implementing the class

Download MailSend_with_AccessXP.zip. You will find a Sample Access2000 compatible Database (downloads/cdo_test.mdb) for testing purposes. Create a class MailSend in your Access-FrontEnd-Database and

Add a reference to the "Microsoft CDO for Exchange 2000 Library" and "Microsoft CDO 1.21 Library" in the VBA-Editor. Then use the Sample Code in the frmMain to adopt the code to your needs.

 

frmMain - Sample Code


Option Compare Database
Option Explicit


Private Sub cmdOK_Click()
Dim clsMailSend As MailSend

    Set clsMailSend = New MailSend

    ' DO NOT TRY TO SEND WITH THIS E-MAIL ADDRESSES
    ' Correct them and remove the Exit Sub Statement!

    Exit Sub

    With clsMailSend
        .From "DOE, John", "john.doe@unknown.at"
        .AddRecipient "", "webmaster@unknown.at", CdoTo
        .AddRecipient "", "webmaster@dom1.at", CdoBcc
        .AddRecipient "", "webmaster@dom2.at", CdoBcc
        .AddRecipient "", "webmaster@dom3.at", CdoBcc
        .Subject = "Only a Test Subject"
        .Body = "Only some words for a message body"
        .AddAttachment "C:\tmp\rpt_TagPerson.pdf", "", ""
        .AddAttachment "C:\tmp\rpt_TagPerson_alle.pdf", "", ""
        .send
    End With

    Set clsMailSend = Nothing

End Sub


This is all you need to send a mail with many attachments and recipients.

 

The MailSend Class


Option Compare Database
Option Explicit

' class MailSend
' 2004-07-29 wilhelm.moser@demos.at
'
' Dependencies:
' Collaborative Data Objects CD0 1.2.1
' in Microsoft CDO for Exchange 2000 Library
' Microsoft CDO 1.21 Library
' at C:\Programme\Gemeinsame Dateien\Microsoft Shared\CDO\CDOEX.DLL
' + for further Dependencies of CDOEX.DLL see CDO 1.2.1 Reference
' URL http://msdn.microsoft.com/library/default.asp?url=/library/en-us/e2k3/e2k3/_esdk_reference_cdoex.asp?frame=true
'
' References:
' VBA for Access use Microsoft CDO for Exchange 2000 Library
'
' comments:
' CDO is System Independent! As long as you use any Windows 2000,2003,XP OS
' you do not need to have an e-mail client installed
' for Exchange 2000 means that the mail-requirements for Exchange are given
' See it as an information CDO format's the messages for standard mail with
' practically any MailServer!

' Description:
' This Class will allow you to define an email with attachments and Recipients
' and to send it (CDO is capable of IMAP Listing recieving mails and a lot more!)
'


Private mMessage As CDO.Message
'
Private mSubject As String
Private mBody As String
Private mFrom As String
Private mTo As String
Private mToCount As Long
Private mCc As String
Private mCcCount As Long
Private mBcc As String
Private mBccCount As Long

Private mError As String

Property Get AttachmentCounter() As Long
    AttachmentCounter = mMessage.Attachments.Count
End Property

Property Get Error() As String
    Error = mError
End Property

Property Let Subject(strSubject As String)
    mSubject = strSubject
End Property

Property Get Subject() As String
    Subject = mSubject
End Property

Property Let Body(strBody As String)
    mBody = strBody
End Property

Property Get Body() As String
    Body = mBody
End Property

Property Get Sender() As String
    Sender = mFrom
End Property

Private Sub Class_Initialize()
    Set mMessage = CreateObject("CDO.Message")
End Sub

Private Sub Class_Terminate()
    Set mMessage = Nothing
End Sub

Public Sub Clear()
    Set mMessage = Nothing
    Set mMessage = CreateObject("CDO.Message")
End Sub

Public Sub From(strName As String, strEmail As String)

    If strEmail = "" Then
        mError = "You must submit at least an email-from address!"
        Exit Sub
    End If

    If strName = "" Then strName = strEmail

    mFrom = """" & strName & """ <" & strEmail & ">"

End Sub

Private Sub AddRecipientToString(strToAddTo As String, strRecipient As String, lngMaxReciepients As Long)
' One should not address more than 300 Recipients.
' This will cause errors with quite a lot of Mailservers

    If (lngMaxReciepients + 1) = 301 Then
        mError = "Maximum of 300 Recipients reached!"
        Exit Sub
    Else
        lngMaxReciepients = lngMaxReciepients + 1
    End If

    If strToAddTo = "" Then
        strToAddTo = strToAddTo & strRecipient
    Else
        strToAddTo = strToAddTo & "; " & strRecipient
    End If

End Sub


Public Sub AddRecipient(strName As String, strEmail As String, enCdoRecipientType As CdoRecipientType)
Dim strToAdd As String

    If strEmail = "" Then
        mError = "You must submit at least an email address!"
        Exit Sub
    End If

    If strName = "" Then strName = strEmail

    strToAdd = """" & strName & """ <" & strEmail & ">"

    Select Case enCdoRecipientType
        Case CdoTo
            AddRecipientToString mTo, strToAdd, mToCount
        Case CdoCc
            AddRecipientToString mCc, strToAdd, mCcCount
        Case CdoBcc
            AddRecipientToString mBcc, strToAdd, mBccCount
    End Select

End Sub

Public Sub AddAttachment(strUrlOrPathFileName As String, Optional UserName As String = "", Optional Password As String = "")
    mMessage.AddAttachment strUrlOrPathFileName, UserName, Password
End Sub
 


Public Function send() As Boolean

On Error GoTo Error

    If (mFrom = "") Or (mTo = "") Or (mSubject = "") Then
        send = False
        mError = "Please submit a From-, To-Address and a Subject!"
        Exit Function
    End If


    With mMessage
        .To = mTo
        .From = mFrom
        .BCC = mBcc
        .Subject = mSubject
        .TextBody = mBody
        .send
        ' We really should do something to fetch possible errors and to
        ' pass them to the ErrorProperty, informing the user of the whereabouts
        ' I think the Goto Error is not really enough
   
End With


Quit:
    send = True
    mError = "Message sent!"
    Exit Function

Error:
    mError = Err.Description
    send = False

End Function


' That really is all for Sending-Mail's without headaches... Have Fun

your willi moser

 

See also:

                        CDOEX.DLL-Reference (Microsoft-MSDN)

 

Copyright:

All this Code is CopyLefted as long as leaving the copyright is up to me.

[ top ]