CDO 2000 class for sending emails

The CDO2000 class allows to send emails w/o user intervention using a SMTP server.

An example on how to use the class can be found at CDO 2000 class for sending emails

.

Note 1 CDO 2000

is included in Windows 2000 and later.

Note 2 A character set of any body part is controlled by Charset property

. The default is "us-ascii".

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320


* CDO2000.prg

#DEFINE cdoSendPassword "http://schemas.microsoft.com/cdo/configuration/sendpassword"
#DEFINE cdoSendUserName "http://schemas.microsoft.com/cdo/configuration/sendusername"
#DEFINE cdoSendUsingMethod "http://schemas.microsoft.com/cdo/configuration/sendusing"
#DEFINE cdoSMTPAuthenticate "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
#DEFINE cdoSMTPConnectionTimeout "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
#DEFINE cdoSMTPServer "http://schemas.microsoft.com/cdo/configuration/smtpserver"
#DEFINE cdoSMTPServerPort "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
#DEFINE cdoSMTPUseSSL "http://schemas.microsoft.com/cdo/configuration/smtpusessl"
#DEFINE cdoURLGetLatestVersion "http://schemas.microsoft.com/cdo/configuration/urlgetlatestversion"
#DEFINE cdoAnonymous 0	&& Perform no authentication (anonymous)
#DEFINE cdoBasic 1	&& Use the basic (clear text) authentication mechanism.
#DEFINE cdoSendUsingPort 2	&& Send the message using the SMTP protocol over the network.
#DEFINE cdoXMailer "urn:schemas:mailheader:x-mailer"

DEFINE CLASS cdo2000 AS Custom

	PROTECTED aErrors[1], nErrorCount, oMsg, oCfg, cXMailer

	nErrorCount = 0

	* Message attributes
	oMsg = Null
		
	cFrom = ""
	cReplyTo = ""
	cTo = ""
	cCC = ""
	cBCC = ""
	cAttachment = ""

	cSubject = ""
	cHtmlBody = ""
	cTextBody = ""
	cHtmlBodyUrl = ""

	cCharset = ""

	* Priority: Normal, High, Low or empty value (Default)
	cPriority = ""

	* Configuration object fields values
	oCfg = Null
	cServer = ""
	nServerPort = 25
	* Use SSL connection
	lUseSSL = .F.
	nConnectionTimeout = 30			&& Default 30 sec's
	nAuthenticate = cdoAnonymous
	cUserName = ""
	cPassword = ""
	* Do not use cache for cHtmlBodyUrl
	lURLGetLatestVersion = .T.

	* Optional. Creates your own X-MAILER field in the header
	cXMailer = "VFP CDO 2000 mailer Ver 1.1.100 2010"

	PROTECTED PROCEDURE Init
		This.ClearErrors()
	ENDPROC

	* Send message
	PROCEDURE Send

		IF This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF

		WITH This
			.ClearErrors()
			.oCfg = CREATEOBJECT("CDO.Configuration")
			.oMsg = CREATEOBJECT("CDO.Message")
			.oMsg.Configuration = This.oCfg
		ENDWITH

		* Fill message attributes
		LOCAL lnind, laList[1], loHeader, laDummy[1], lcMailHeader

		IF This.SetConfiguration() > 0
			RETURN This.GetErrorCount()
		ENDIF

		IF EMPTY(This.cFrom)
			This.AddError("ERROR : From is empty.")
		ENDIF
		IF EMPTY(This.cSubject)
			This.AddError("ERROR : Subject is empty.")
		ENDIF

		IF EMPTY(This.cTo) AND EMPTY(This.cCC) AND EMPTY(This.cBCC)
			This.AddError("ERROR : To, CC and BCC are all empty.")
		ENDIF

		IF This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF

		This.SetHeader()

		WITH This.oMsg

			.From     = This.cFrom
			.ReplyTo  = This.cReplyTo

			.To       = This.cTo
			.CC       = This.cCC
			.BCC      = This.cBCC
			.Subject  = This.cSubject

			* Create HTML body from external HTML (file, URL)
			IF NOT EMPTY(This.cHtmlBodyUrl)
				.CreateMHTMLBody(This.cHtmlBodyUrl)
			ENDIF

			* Send HTML body. Creates TextBody as well
			IF NOT EMPTY(This.cHtmlBody)
				.HtmlBody = This.cHtmlBody
			ENDIF

			* Send Text body. Could be different from HtmlBody, if any
			IF NOT EMPTY(This.cTextBody)
				.TextBody = This.cTextBody
			ENDIF

			IF NOT EMPTY(This.cCharset)
				IF NOT EMPTY(.HtmlBody)
					.HtmlBodyPart.Charset = This.cCharset
				ENDIF

				IF NOT EMPTY(.TextBody)
					.TextBodyPart.Charset = This.cCharset
				ENDIF
			ENDIF
			
			* Process attachments
			IF NOT EMPTY(This.cAttachment)
				* Accepts comma or semicolon
				* VFP 7.0 and later
				*FOR lnind=1 TO ALINES(laList, This.cAttachment, [,], [;])
				* VFP 6.0 and later compatible
				FOR lnind=1 TO ALINES(laList, CHRTRAN(This.cAttachment, [,;], CHR(13) + CHR(13)))
					lcAttachment = ALLTRIM(laList[lnind])
					* Ignore empty values
					IF EMPTY(laList[lnind])
						LOOP
					ENDIF

					* Make sure that attachment exists
					IF ADIR(laDummy, lcAttachment) = 0
						This.AddError("ERROR: Attachment not Found - " + lcAttachment)
					ELSE
						* The full path is required.
						IF 	UPPER(lcAttachment) <> UPPER(FULLPATH(lcAttachment))
							lcAttachment = FULLPATH(lcAttachment)
						ENDIF
						.AddAttachment(lcAttachment)
					ENDIF
				ENDFOR
			ENDIF

			IF NOT EMPTY(This.cCharset)
				.BodyPart.Charset = This.cCharset
			ENDIF

			* Priority
			IF NOT EMPTY(This.cPriority)
				lcMailHeader = "urn:schemas:mailheader:"
				.Fields(lcMailHeader + "Priority")   = LOWER(This.cPriority)
				.Fields(lcMailHeader + "Importance") = LOWER(This.cPriority)
				DO CASE
				CASE This.cPriority = "High"
					.Fields(lcMailHeader + "X-Priority") = 1 && 5=Low, 3=Normal, 1=High
				CASE This.cPriority = "Normal"
					.Fields(lcMailHeader + "X-Priority") = 3 && 5=Low, 3=Normal, 1=High
				CASE This.cPriority = "Low"
					.Fields(lcMailHeader + "X-Priority") = 5 && 5=Low, 3=Normal, 1=High
				ENDCASE
				.Fields.Update()
			ENDIF
		ENDWITH

		IF This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF

		This.oMsg.Send()

		RETURN This.GetErrorCount()

	ENDPROC

	* Clear errors collection
	PROCEDURE ClearErrors()
		This.nErrorCount = 0
		DIMENSION This.aErrors[1]
		This.aErrors[1] = Null
		RETURN This.nErrorCount
	ENDPROC

	* Return # of errors in the error collection
	PROCEDURE GetErrorCount
		RETURN This.nErrorCount
	ENDPROC

	* Return error by index
	PROCEDURE GetError
		LPARAMETERS tnErrorno
		IF	tnErrorno <= This.GetErrorCount()
			RETURN This.aErrors[tnErrorno]
		ELSE
			RETURN Null
		ENDIF
	ENDPROC

	* Populate configuration object
	PROTECTED PROCEDURE SetConfiguration

		* Validate supplied configuration values
		IF EMPTY(This.cServer)
			This.AddError("ERROR: SMTP Server isn't specified.")
		ENDIF
		IF NOT INLIST(This.nAuthenticate, cdoAnonymous, cdoBasic)
			This.AddError("ERROR: Invalid Authentication protocol ")
		ENDIF
		IF This.nAuthenticate = cdoBasic ;
				AND (EMPTY(This.cUserName) OR EMPTY(This.cPassword))
			This.AddError("ERROR: User name/Password is required for basic authentication")
		ENDIF

		IF 	This.GetErrorCount() > 0
			RETURN This.GetErrorCount()
		ENDIF

		WITH This.oCfg.Fields

			* Send using SMTP server
			.Item(cdoSendUsingMethod) = cdoSendUsingPort
			.Item(cdoSMTPServer) = This.cServer
			.Item(cdoSMTPServerPort) = This.nServerPort
			.Item(cdoSMTPConnectionTimeout) = This.nConnectionTimeout

			.Item(cdoSMTPAuthenticate) = This.nAuthenticate
			IF This.nAuthenticate = cdoBasic
				.Item(cdoSendUserName) = This.cUserName
				.Item(cdoSendPassword) = This.cPassword
			ENDIF
			.Item(cdoURLGetLatestVersion) = This.lURLGetLatestVersion
			.Item(cdoSMTPUseSSL) = This.lUseSSL

			.Update()
		ENDWITH

		RETURN This.GetErrorCount()

	ENDPROC

	*----------------------------------------------------
	* Add message to the error collection
	PROTECTED PROCEDURE AddError
		LPARAMETERS tcErrorMsg
		This.nErrorCount = This.nErrorCount + 1
		DIMENSION This.aErrors[This.nErrorCount]
		This.aErrors[This.nErrorCount] = tcErrorMsg
		RETURN This.nErrorCount
	ENDPROC

	*----------------------------------------------------
	* Format an error message and add to the error collection
	PROTECTED PROCEDURE AddOneError
		LPARAMETERS tcPrefix, tnError, tcMethod, tnLine
		LOCAL lcErrorMsg, laList[1]
		IF INLIST(tnError, 1427,1429)
			AERROR(laList)
			lcErrorMsg = TRANSFORM(laList[7], "@0") + "  " + laList[3]
		ELSE
			lcErrorMsg = MESSAGE()
		ENDIF
		This.AddError(tcPrefix + ":" + TRANSFORM(tnError) + " # " + ;
			tcMethod + " # " + TRANSFORM(tnLine) + " # " + lcErrorMsg)
		RETURN This.nErrorCount
	ENDPROC

	*----------------------------------------------------
	* Simple Error handler. Adds VFP error to the objects error collection
	PROTECTED PROCEDURE Error
		LPARAMETERS tnError, tcMethod, tnLine
		This.AddOneError("ERROR: ", tnError, tcMethod, tnLine )
		RETURN This.nErrorCount
	ENDPROC

	*-------------------------------------------------------
	* Set mail header fields, if necessary. For now sets X-MAILER, if specified
	PROTECTED PROCEDURE SetHeader
		LOCAL loHeader
		IF NOT EMPTY(This.cXMailer)
			loHeader = This.oMsg.Fields
			WITH loHeader
				.Item(cdoXMailer) =  This.cXMailer
				.Update()
			ENDWITH
		ENDIF
	ENDPROC

	*----------------------------------------------------
	*
	PROTECTED PROCEDURE cPriority_assign(tvVal)
		* Check for incorrect values
		IF INLIST("~" + PROPER(tvVal) + "~", "~High~", "~Normal~", "~Low~") OR EMPTY(tvVal)
			This.cPriority = PROPER(ALLTRIM(tvVal))
		ELSE
			This.AddError("ERROR: Invalid value for cPriority property.")	
		ENDIF
	ENDPROC

ENDDEFINE

Comments

Hi Sergey,
Thank's for you excellent posts.

I need an help for CDO MAIL
Do you know If is possible send a conditionally mail such as DISPLAY methods of mapi or Send(True) of CDO1.0 ??
Please help me if possible
thank's
Gianni

Hi Gianni,

CDO 2000 does not rely on any email client installed on PC and as result cannot use them to display email before sending.

It's ok
do you know any EXTENDED MAPI wrapper that is usable by VFP ?

I don't know about c++ then i searching for a C++ develepper that can vrite a FLL to use it by VFP

this because CDO is excellent but i think that it have 2 problems
1° don't is user interactive
2° don't save sended messages into Sended mail folder of default profile that user corrently use.

Can you say me how do you do this feature?

Hi Gianni ,

Craig Boyd posted free <a href = "http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,baccc84d-4d91-458b-a839-ad03662dfc34.aspx">VFP Extended MAPI FLL</a> in his blog at http://www.sweetpotatosoftware.com/SPSBlog.

Hi
i try to send xls file , but can't open att file .
can u help me?
thx a lot
Tommy

I use CDO 2000 to send all kinds of attachments and don't have any problems with it.

Thanks a lot Sergey, this class is really great, and I've been using it in production with 100% of satisfaction, and it included in the sources of FoxyPreviewer - http://foxypreviewer.codeplex.com/
Just wanted to pass to you some few enhancements that I made:

1 - The error handling works perfectly. But noticed that the error messages returned by the class in most cases bring a CHR(0) in the message. The VFP MESSAGEBOX() command can't show texts that have CHR(0) correctly, because it thinks that the string has ended when it finds it. So I just included this line in the method "AddOneError":
1
2
lcErrorMsg = CHRTRAN(lcErrorMsg, CHR(0), "")


2 - I've added the possibility of setting the "Priority" and "Ask for read receipt".
Included 2 properties: "lPriority" and "lReadReceipt"
In procedure "Send", included the code below:

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16

* http://support.microsoft.com/kb/302839
IF This.lReadReceipt
   This.oMsg.Fields("urn:schemas:mailheader:disposition-notification-to") = This.cTo
   This.oMsg.Fields("urn:schemas:mailheader:return-receipt-to") = This.cTo
   This.oMsg.Fields.Update()
ENDIF

* Set priority if needed
IF This.lPriority
   This.oMsg.Fields("Priority").Value = 1   &amp;&amp; -1=Low, 0=Normal, 1=High
   This.oMsg.Fields.Item("urn:schemas:mailheader:X-Priority") = 1 &amp;&amp; -1=Low, 0=Normal, 1=High
   This.oMsg.Fields.Item("urn:schemas:httpmail:importance") = 1
   This.oMsg.Fields.Update()
ENDIF 


Thanks again for this class and for the samples for using it with the several SMTP email servers. The <b>BEREZNIKEROPEDIA ROCKS</b> !!!

Regards

Hi Cesar,

Thank you for kind words and updates.

1 - CHR(0) shouldn't be in the message in the first place. I removed the item that has value of CHR(0) from the error message created.
2 - Per your suggestion, implemented cPriority property with values 'High", "Normal" and "Low"

Thanks again,

Sergey

Hi Sergey,

I'm getting the following error(s) when running the code below:

"ERROR: :1429 # SEND # 252 # 0x00000213 CDO.Message.1 The transport failed to connect to the server."

Can you throw any light on this?

TIA, Herb
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
* SendMail.prg

* Outlook Express is configured to send e-mail but is not the default e-mail client.
* That should provide CDO with the registry entries it needs??

* loMail = NEWOBJECT("CDO2000", "CDO2000.fxp")
loMail	= CREATEOBJECT("CDO2000")

WITH loMail
	* Mailer Setup
	.cServer		= "smtp.live.com"
	.nServerPort	= 25
	.lUseSSL		= .T.
	.nAuthenticate	= 1

	* Sender's Credentials
 	.cUserName	= user_addr
	.cPassword	= user_pword
 
	* Email details
 	.cFrom		= .cUserName
	.cTo		= mail_to
	.cSubject		= mail_title
	.cTextBody	= mail_body
 
	* Attachment(s)
	.cAttachment	= attachment

ENDWITH

...

RETURN 

Hi Herb,

The error "The transport failed to connect to the server" means that either server at smtp.live.com is unaccessible or port 25 is blocked by firewall.

Outlook Express is not required for this class to work because all necessary configuration parameters are provided in the class properties.

Thanks Sergey,
It works much better now that I've replaced your "smtp.live.com" with my SMTP server name.

I tried to send mail from foxypreviewer but got error

---------------------------
Error sending email
---------------------------
Error sending email:
#1429 - send - 0x00000211 The message could not be sent to the SMTP server. The transport error code was 0x80040217. The server response was not available

Message was not sent
---------------------------
OK
---------------------------


telnet smptserver.com 25

shows that port is open.
How to fix or diagnose this ?
I'm using Windows 7 64 bit.

How to request read receipt ?
There is no such property in this class.

I've a problem with this code. I call this class from code of this page: http://www.berezniker.com/content/pages/visual-foxpro/send-email-cdo-2000 but i've an error when execute the application (on send pass):

The application show me this message: "Operator/operand type mismatch."

In Debug mode, the application stop in this line of code:

This.oMsg.Send()

I just copied your two codes in two separate files. "PRG" and I changed the parameters of the configuration of the e-mail server.

Thanks friend!

Hi Sergey,

It's been a while.

I've used this code to send SMTP mails, and it works very well in my development environment, so thank you very much for another excellent piece of help.
There is a catch: when deployed to the clients site, it still claims that the mails are sent, so no errors, but nothing ever gets through to the receipient.

Unfortunately it's a very closed environment, so I have no way of figuring out what's going on.

So, as usual, any ideas and suggestions you might have, are welcome :-)

TIA,

Peter

There is a catch: when deployed to the clients site, it still claims that the mails are sent, so no errors, but nothing ever gets through to the receipient.

Unfortunately it's a very closed environment, so I have no way of figuring out what's going on.

So, as usual, any ideas and suggestions you might have, are welcome :-)

pathak

Hi Peter,

If CDO 2000 doesn't report any errors when sending email, it means that email has been accepted by the SMTP server. It's responsibility of the person managing the SMTP server to troubleshoot the problem from there.

Hi Sergey,

First off, thanks for posting this class. I've been using it for quite some time now with good results. However, I'm now attempting to do something new and am having some trouble. I'm using the cHtmlBodyUrl property to specify an HTM file that I temporarily create on disk. The file is an HTML-formatted e-mail message with an image included. After sending, that HTM file is locked and cannot be deleted until I totally exit out of VFP. I've tried explicitly releasing everything, but to no avail. I've found a few other posts on forums where people reported the same thing, and the call to the CDO CreateMHTMLBody() method appears to be what locks the file. But I cannot figure out how to unlock it afterwards.

Thanks,

Jon

Hi Jon,

Make sure that you use <b>file://</b> prefix for cHtmlBodyUrl property

1
2
    .cHtmlBodyUrl = "file://dir1/filename.html"

Great, that seemed to be my problem! Thanks so much.

Jon

Hi Sergey

I am only a foxpro simple programmer, dont know how to use C coding, and need to send email. I tried all above with just cut and paste in different Prg. I have Windows Live mail installed and I use hotmail account to send/receive mail. So, thats why I do not know the server name and the port name.
Kindly help me in that

Thanks in advance

Shakeel

Hi Shakeel,

Check <a href="/content/pages/visual-foxpro/send-email-msn-email-account">Send email via MSN email account</a>

Hi Sergey,
I am using your code, from last 6 months. Without any error. But some of my clients face error doing so. they receive
: The Transport Failed To Connect To The Server.
If this is a port 465 problem, please guide how to resolve it. They all are using Win-XP, with antivirus installed. (But the firewall are off)

Hello Sergey,

Is there an option to add the actual sender's name so the recipient will see it shown? I was trying to use .Sender property, but it doesn't seem to affect anything.
Thanks in advance!

You have no control how From/To address will be displayed at destination. It will depends on email client used. But you can add a name part that could be displayed by an email client.
<code>
.cFrom = ["My display name"<user@myemail.com>]
...
</code>

It worked, thank you so much!

Thank you for giving the community this wonderful tool, Sergey.

There is error sending email in a CDO mode seems dont find the CDO2000 class !
#1733 send - Class definition CDO-Configuration is not found !
#1733 Send - Class definition CDO-MESSAGE is not found !
#1925 Send - Unknown menber OMSG not found !
and also in the MAPI mode does not work Error # 2 one or more unspecified errors occurs while sending messages !

There's no MAPI or CDO mode in this class

Hello, I want to thank you so much. You are a unique evidence that there is a good man in the world yet. My question is how to send from smtp.google.com if there port is 465? How to change port in this class to 465 instead 25?

See https://www.berezniker.com/content/pages/visual-foxpro/send-email-gmail-account