download MailSend_with_AccessXP.zip ( 29 kb)
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.
If you are getting an Error like "The 'SendUsing' configuration value is
invalid" on
debugging
MailSend.send
Error:
mError
= Err.Description
send = False
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.
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.
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
CDOEX.DLL-Reference (Microsoft-MSDN)
All this Code is CopyLefted as long as leaving the copyright is up to me.
[ top ]