Welcome To The Home Of The Visual FoxPro Experts  
home. signup. forum. archives. search. google. articles. downloads. faq. members. weblogs. file info. rss.
 From: Don Higgins
  Where is Don Higgins?
 Peoria
 Illinois - United States
 Don Higgins
 To: Ahsan Rana
  Where is Ahsan Rana?
 Lahore
 Pakistan
 Ahsan Rana
 Tags
Subject: RE: CDO Configuration
Thread ID: 249156 Message ID: 249168 # Views: 20 # Ratings: 1
Version: Visual FoxPro 7 Category: Other
Date: Tuesday, December 29, 2009 11:50:32 PM         
   


I use this code and it works great, it has two options. 1 is regular CDO that works fine for local email accounts ( Not Yahoo or MSN types ) and one Sergy made for Yahoo type accounts. His website is: http://www.berezniker.com/

It is driven by a database called Comset.dbf If you need a copy let me know.

It is a form Method and is easy to impliment.



********************************************************************
*** Name.....: QuickQuote.TEXT_MESSAGE
*** Author...: Don Higgins
*** Date.....: 12/17/2008
*** Notice...: Common Sense Software
*** Compiler.: Visual FoxPro 09.00.0000.2412 for Windows
*** Function.: Very simple Text Message or Email from within Profit Trak Software
*** Returns..: Nothing, just sends out texts and emails
********************************************************************
*
* Parameter List:
* a) is whatever needs to be emailed or texted
* b) File Attachment?
* c) Email?  If so then TRUE
*
*
* uses Comset.dbf file for settings and phone numbers
********


Lparameters tcMessage, tcAttachedFile, tcEmail




**** Begin CDO Version  *******
Local lcSchema, loConfig, loMsg, loError, lcErr, lcTextBody, lcRecipient1, lcRecipient2, lcRecipient3, ;
	lcLogin, lcPassword, lcSMTPPort, lcSMTPServer, lcAllRecipients, lcBCC, lcCC, lcEmail_Address, lcAttachedFile, ;
	lcSalesno, lcSalesName, lcDealerName, lnSendVia, lcWait_Window_Message, lcTextAddress, myPriority, lcFullFileName

myPriority="H"
lnSendVia = 1
lcFullFileName = "Valued_Customer_Proposal.pdf"
lcFullFileName = Fullpath(lcFullFileName)

* Check to see if this is an email
* if not use text field
If tcEmail = .T.
	lcRecipient1 = Alltrim(Payment.email)
Else
	* get customer's email from payment.dbf field email.
	* FIRST try to get their text address
	* if not there use payment.email
	lcTextAddress = Alltrim(Payment.textadd)
	* if it is not empty then everything is GREAT!
	If .Not. Empty( lcTextAddress )
		* Text address is good
		lcRecipient1 = lcTextAddress
	Else
		lcRecipient1 = Alltrim(Payment.email)
	Endif
Endif



* salesperson name below
* get number from payment.dbf
* then look up name from sales.dbf
lcSalesno = Payment.salesno
* open sales
Do openit In Main With "data\sales"
Locate For salesno = lcSalesno
lcSalesName = Alltrim(sales.salesname)
* lcSalesName = LOWER(Alltrim(sales.salesname))
* Now remove ANY Spaces between first and last name or errors happen
* lcSalesName = CHRTRAN(lcSalesName,' ','')

* now chrtran the dealership name to remove spaces and reduce to lower()
Thisform.Dealership_name = Lower(Thisform.Dealership_name)
lcDealerName = Chrtran(Thisform.Dealership_name,' ','')


* put it together with @ symbol and dealer name
*lcEmail_Address = lcSalesName + "@" + lcDealerName





* did we get a message?  If not get out now
Do Case

	Case Pcount() = 0
		* how this could happen is beyond me but get out now
		Return

	Case Pcount() = 1
		* we have a message but no attached file to send
		lcTextBody = Alltrim( tcMessage )
		lcAttachedFile = ""
		llEmail = .F.

	Case Pcount() = 2
		* we have a message and an attached file
		lcTextBody = Alltrim( tcMessage )
		lcAttachedFile = tcAttachedFile
		llEmail = .F.

	Case Pcount() = 3
		* we have a message and an attached file and it is an email
		lcTextBody = Alltrim( tcMessage )
		lcAttachedFile = tcAttachedFile
		llEmail = .T.

Endcase

lcWait_Window_Message = "Sent " + Iif(llEmail = .F.,"Text ","Email ") + " Message to their Phone..."

* Open Comset.dbf and get setup information
Do openit In Main With "data\comset"

* up to 3 recipients
* these will be phone numbers @ vtext.com for example
* they can also be email addresses
* if there is no rec1 then get the hell out also
* no reason to continue if there isnt anyone to send
If Empty(lcRecipient1)
	Wait Window "Ummmmm..... There is NO Phone Number to Text or Email - Exiting Now " Timeout 5000
	Return
Endif
* OK we have at least one so lets get going
* 2nd person now.  Use Blind Carbon Copy for simplicity
lcRecipient2 = Alltrim(comset.rec2)
If .Not. Empty(lcRecipient2)
	* if not empty then do nothing except set variable for bcc
	lcBCC = lcRecipient2
Else
	lcBCC = ""
Endif

* 3rd person now
* uses Carbon Copy property
lcRecipient3 = Alltrim(comset.rec3)
If .Not. Empty(lcRecipient3)
	lcCC = lcRecipient3
Else
	lcCC = ""
Endif




* Now the setup info for the important stuff
lcLogin = comset.login
lcPassword = comset.pword
lcSMTPPort = comset.smtpport
lcSMTPServer = comset.servr
***
*
*  OK comset.sendvia is numberic and will be as follows:
* 1 = Normal CDO
* 2 = Sergieo CDO Class
* This determines how the code sends emails and texts
lnSendVia = comset.sendvia
* Make sure it is a valid number
If lnSendVia = 0
	lnSendVia = 1
Endif


* Email Address - from sender area
* If it is blank put mine in
lcEmail_Address = Alltrim(comset.emailname)
If Empty(Alltrim( lcEmail_Address ))
	lcEmail_Address = "don@crew-chief.com"
Endif


* close comset - can't afford corrupted files
Select comset
Use



* OK check for the attached file does in fact exist on the system
llExist = .F.
Do fndfile In Main With lcAttachedFile
If llExist = .T.
	* file exists move on now - everyone is happy, happy, happy!
Else
	* Wait Window "File is Not Valid..."
	* Danger will robinson
	* file does not exist
	* make the local variable empty then
	lcAttachedFile = ""
	*Wait Window "File: " + Alltrim( lcAttachedFile ) + " Does not exist...." Timeout 5000
Endif


Do Case
	Case lnSendVia = 1  && Regular CDO sending code

		lcErr = ""
		lcSchema = "http://schemas.microsoft.com/cdo/configuration/"

		loConfig = Createobject("CDO.Configuration")

		With loConfig.Fields
			.Item(lcSchema + "smtpserver") = Alltrim(lcSMTPServer)  &&"mail.crew-chief.com"
			.Item(lcSchema + "smtpserverport") = (lcSMTPPort)  &&587 && yr  smtp port &&
			.Item(lcSchema + "sendusing") = 2
			.Item(lcSchema + "smtpauthenticate") = .T.
			.Item(lcSchema + "smtpusessl") = .F.
			.Item(lcSchema + "sendusername") = Alltrim(lcLogin)
			.Item(lcSchema + "sendpassword") = Alltrim( lcPassword )

			*.Fields("urn:schemas:httpmail:importance").Value = Icase(myPriority="H",2,myPriority="L",0,1)
			*.Fields("urn:schemas:mailheader:importance").Value = Icase(myPriority="H","High",myPriority="L","Low","Normal")

			.Update

		Endwith

		loMsg = Createobject ("CDO.Message")


		With loMsg
			.Configuration = loConfig

			.From = lcEmail_Address   &&"don@crew-chief.com"

			.To 	= lcRecipient1
			.bcc 	= lcBCC
			.cc		= lcCC

			*    .DSNOptions=2   & if u define this setting mails are not save at sender end

			.Subject = "From: " + Alltrim(Proper(Thisform.Dealership_name))

			.TextBody = ( lcTextBody )

			* Set Step On

			* Only send if llExist = .t. ( look above for this )
			If llExist = .T.
					* don't need attachments if this is an text
				If tcEmail = .T.
					.AddAttachment(lcFullFileName)  &&'c:\coprofit\valued_customer_proposal.pdf')
					* &lcFullFileName
				Endif
			Endif

			*
			.Send()
			*

		Endwith

		If Vartype(loMsg)='O'
			Wait Window (lcWait_Window_Message)  Nowait
		Else
			Messagebox('Error: Could Not Send - Something in your information is incorrect.  Contact us to get help', 16 , "Failed due to error")
		Endif

		Release lcMessage,lcSchema,loConfig,loMsg,loError,lcErr
		loMsg = .Null.









	Case lnSendVia = 2
		* Sergey's class.  Download cdo2000.prg at http://www.berezniker.com/

		* Replace addresses with real ones before running the code

		loMail = Newobject("Cdo2000", "Cdo2000.fxp")

		With loMail

			.cServer = Alltrim(lcSMTPServer)   && "smtp.mail.yahoo.com"
			.nServerPort = (lcSMTPPort)   &&465
			.lUseSSL = .T.

			.nAuthenticate = 1 	&& cdoBasic
			*.cUserName = "yourYahooAccount@Yahoo.com"
			*.cPassword = "yourYahooPassword"
			.cUserName = Alltrim(lcLogin)  &&"crewchiefpro50@yahoo.com"
			.cPassword = Alltrim( lcPassword )


			* The From address has to be one the registered identities (Yahoo accounts),
			*.cFrom = "yourYahooAccount@Yahoo.com"


			.cFrom = .cUserName

			*.cTo = "somebody@otherdomain.com, somebodyelse@otherdomain.com"

			.cTo = lcRecipient1  &&"don@crew-chief.com;crewchiefpro@live.com"


			.cSubject = "From: " + Alltrim(Proper(Thisform.Dealership_name))

			* Uncomment next lines to send HTML body
			*.cHtmlBody = "<b>This is an HTML body<br>" + ;
			*		"It'll be displayed by most email clients</b>"

			.cTextBody =  ( lcTextBody )

			* Attachments are optional
			.cAttachment = lcAttachedFile

		Endwith

		If loMail.Send() > 0
			For i=1 To loMail.GetErrorCount()
				*MESSAGEBOX("Error: " +  i, loMail.Geterror(i),0,"Error Message )
				@ 2,1 Say i
				@ 3,1 Say loMail.Geterror(i)
			Endfor
		Else
			Wait Window (lcWait_Window_Message)  Nowait
		Endif

		* clear any reference to the object
		Release loMail
		loMail = .Null.


Endcase


* return to payment just to be sure
Select Payment

Return











> Hi Expert
>
> Following is the Code I use to Configure CDO Messaging but it does not configure. Can any one help me to Configure it. Afterward I try with Outlook Express. Now system successfully sending mail but it takes about one minute for each mail. My Mail sending code is also hereunder:
>
> LOCAL loConfig AS CDO.Configuration, loFlds AS Object, loMsg AS CDO.Message
>
> loConfig = CREATEOBJECT("CDO.Configuration")
> loFlds = loConfig.Fields
>
> WITH loFlds
> *- Set the CDOSYS configuration fields to use port 25 on the SMTP server.
> .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
>
> *- Enter name or IP address of remote SMTP server.
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 && 467
>
> *- Assign timeout in seconds
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 20
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = .t. && .f.
> .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "ahsanrana59@gmail.com"
> .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="abc"
> *!* .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
> *!* .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="password"
> .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
>
> .Update()
> ENDWITH
>
> **************************************************
>
> DECLARE SHORT InternetGetConnectedState In WinInet.Dll ;
> INTEGER @lpdwFlags, Integer dwReserved
> LOCAL lConnected
> lConnected = .F.
> lpdwFlags = 0
> IF InternetGetConnectedState (@lpdwFlags, 0) = 1
> lConnected = .T.
> ENDIF
>
> IF lConnected = .T.
> oMSG = CREATEOBJECT("CDO.Message")
> oMSG.To = Thisform.txtEmailAdd.Value
> oMSG.From = Thisform.txtSender.Value
> oMSG.Subject = Thisform.txtSubject.Value
> oMSG.TextBody = ALLTRIM(Thisform.Edit1.Value)
> IF !EMPTY(Thisform.txtAttachment.Value)
> oMsg.AddAttachment(Thisform.txtAttachment.Value)
> ENDIF
> oMSG.Send()
> WAIT WINDOW 'Message to '+ALLTRIM(nm)+' successfully delivered' NOWAIT
> ENDIF
>
> Rgds:
> Ahsan Rana



Don Higgins



http://www.youtube.com/watch?v=dcuFx85o8XU


ENTIRE THREAD

CDO Configuration Posted by Ahsan Rana @ 12/29/2009 4:41:10 PM
RE: CDO Configuration Posted by Mike Gagnon @ 12/29/2009 5:46:32 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 5:19:21 AM
RE: CDO Configuration Posted by Mike Gagnon @ 12/30/2009 12:31:25 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 4:22:24 PM
RE: CDO Configuration Posted by Don Higgins @ 12/29/2009 11:50:32 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 5:13:35 AM
RE: CDO Configuration Posted by M. Akram Bhatti @ 12/30/2009 7:26:42 AM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 4:34:00 PM
RE: CDO Configuration Posted by M. Akram Bhatti @ 12/30/2009 6:02:06 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/30/2009 6:40:41 PM
RE: CDO Configuration Posted by Mike Gagnon @ 12/30/2009 11:10:02 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/31/2009 4:11:44 AM
RE: CDO Configuration Posted by Mike Gagnon @ 12/31/2009 12:39:07 PM
RE: CDO Configuration Posted by Ahsan Rana @ 12/31/2009 7:12:30 PM
RE: CDO Configuration Posted by Mike Gagnon @ 1/1/2010 1:17:44 PM
RE: CDO Configuration Posted by Ahsan Rana @ 1/3/2010 6:20:24 AM
RE: CDO Configuration Posted by Mike Gagnon @ 1/3/2010 6:26:42 AM
RE: CDO Configuration Posted by Ahsan Rana @ 1/3/2010 2:26:19 PM
RE: CDO Configuration Posted by Mike Gagnon @ 1/3/2010 5:53:29 PM
RE: CDO Configuration Posted by Ahsan Rana @ 1/3/2010 6:31:31 PM
RE: CDO Configuration Posted by Mike Gagnon @ 1/4/2010 1:56:16 AM
RE: CDO Configuration Posted by Digant Vora @ 12/31/2009 6:54:22 AM
RE: CDO Configuration Posted by Mike Gagnon @ 12/31/2009 12:41:17 PM
RE: CDO Configuration Posted by khubaib khalid @ 1/4/2010 2:40:21 PM
RE: CDO Configuration Posted by Ahsan Rana @ 1/4/2010 4:53:03 PM
RE: CDO Configuration Posted by khubaib khalid @ 1/4/2010 5:03:36 PM