Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Outlook Automation Problem - Multiple instances
Message
 
 
To
05/05/2006 07:13:45
Jon Neale
Bond International Software
Wootton Bassett, United Kingdom
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Environment versions
Visual FoxPro:
VFP 8
OS:
Windows XP SP1
Network:
Windows 2000 Server
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01119513
Message ID:
01119533
Views:
21
Jon

Thanks mate, Tried that but still no joy. My workflow mailer program invokes this sendmail procedure. There were six mails to send which it did and guess what, im left with 6 outlook.exe processes in task manager.

Here is my code:
PROCEDURE sendmail
LPARAMETERS lcreciplist,		;	&& recipient list from users table
			lcSubject, ;			&& Subject at top of message
			lcBody, ;			&& Body text of message (can be memo field name)
			lccontrol, ;			&& Body text of message (can be memo field name)
			lccondition, ;			&& Body text of message (can be memo field name)
			lcAttachments, ;		&& List of attachment files with , or ; between
			llReceipt, ;			&& Whether receipt required
			lcRecipients, ;			&& List of recipients with , or ; between - can have cc: or bcc: before each
			lcUserName, ;			&& User (Profile) Name - not needed if client already open
			lcPassword, ;			&& User (Profile) Password
			llShowOutlook 			&& If .T., will open outlook to send manually
			
	
lcmailsent=.f.
llShowOutlook=.f.
lcUserName = 'VWM Workflow'
lcpassword = 'password'

lcRecipients = lcreciplist
lcBodyText = lcbody

IF lcattach = .t.
	lcattachments = ALLTRIM(vwmevents.udf1) + ";" + ALLTRIM(vwmevents.udf2)
ENDIF

LOCAL lnLoop, ;						&& Temporary loop counter
	  lnErrors, ;					&& Number of errors to return
	  lcTemp						&& Temporary string storage
	  
STORE 0 TO lnErrors, ;
		   nRecipCount, ;
		   nCCRecipCount, ;
		   nBCCRecipCount, ;
		   nAttachCount

* Check sufficient data
IF EMPTY(lcRecipients)
	lnErrors=lnErrors+1
	MESSAGEBOX("No Recipients Specified",0,"Error")
ENDIF
IF EMPTY(lcSubject)
	lnErrors=lnErrors+1
	MESSAGEBOX("No Subject Specified",0,"Error")
ENDIF
IF EMPTY(lcBodyText)
	lnErrors=lnErrors+1
	MESSAGEBOX("No Body Text Specified",0,"Error")
ENDIF
IF lnErrors>0
	RETURN lnErrors
ENDIF
IF EMPTY(lcAttachments)
	lcAttachments=""
ENDIF

* Default to empty strings
IF EMPTY(lcUserName)
	lcUserName=""
ENDIF
IF EMPTY(lcPassword)
	lcPassword=""
ENDIF

* Convert commas to semi-colons	  
lcRecipients=STRTRAN(lcRecipients,',',';')
lcAttachments=STRTRAN(lcAttachments,',',';')

* Clear previous recipient arrays
DIMENSION aRecipients[1]
aRecipients=""
DIMENSION aCCRecipients[1]
aCCRecipients=""
DIMENSION aBCCRecipients[1]
aBCCRecipients=""

* Create array of recipients (including cc and bcc)
IF RIGHT(lcRecipients,1)!=';'
	lcRecipients=lcRecipients+';'
ENDIF
lcRecipients=lcRecipients+' '
DO WHILE AT(';',lcRecipients)>0 AND LEN(lcRecipients)>1
	DO CASE
		CASE LOWER(LEFT(lcRecipients,4))="bcc:"
			nBCCRecipCount=nBCCRecipCount+1
			DIMENSION aBCCRecipients[nBCCRecipCount]
			aBCCRecipients[nBCCRecipCount]=LEFT(lcRecipients,AT(';',lcRecipients)-1)
			aBCCRecipients[nBCCRecipCount]=LTRIM(SUBSTR(aBCCRecipients[nBCCRecipCount],5))
		CASE LOWER(LEFT(lcRecipients,3))="cc:"
			nCCRecipCount=nCCRecipCount+1
			DIMENSION aCCRecipients[nCCRecipCount]
			aCCRecipients[nCCRecipCount]=LEFT(lcRecipients,AT(';',lcRecipients)-1)
			aCCRecipients[nCCRecipCount]=LTRIM(SUBSTR(aCCRecipients[nCCRecipCount],4))
		OTHERWISE
			nRecipCount=nRecipCount+1
			DIMENSION aRecipients[nRecipCount]
			aRecipients[nRecipCount]=LEFT(lcRecipients,AT(';',lcRecipients)-1)
	ENDCASE
	lcRecipients=SUBSTR(lcRecipients,AT(';',lcRecipients)+1)
ENDDO

* Convert body text field to data (if it is a field)
IF TYPE(lcBodyText)='M'
	lcTemp=""
	FOR lnLoop=1 TO MEMLINES(&lcBodyText.)
		lcTemp=lcTemp+MLINE(&lcBodyText.,lnLoop)
		lcTemp=lcTemp+CHR(13)
	ENDFOR
	lcBodyText=lcTemp
ENDIF

* Create array of attachment files
aAttachmentFiles=""
IF NOT EMPTY(lcAttachments)
	IF RIGHT(lcAttachments,1)!=';'		&& 22.Apr.99 Bug Fix (replaced , with ;) will still work ok.
		lcAttachments=lcAttachments+';'
	ENDIF
	DIMENSION aAttachmentFiles[OCCURS(';',lcAttachments)]
	nAttachCount=0
	lcAttachments=lcAttachments+' '
	DO WHILE AT(';',lcAttachments)>0 AND LEN(lcAttachments)>1
		nAttachCount=nAttachCount+1
		aAttachmentFiles[nAttachCount]=LEFT(lcAttachments,AT(';',lcAttachments)-1)
		lcAttachments=SUBSTR(lcAttachments,AT(';',lcAttachments)+1)
	ENDDO
ENDIF

* Check that all attachment files exist
FOR lnLoop=1 TO nAttachCount
	IF NOT FILE(aAttachmentFiles[lnLoop])
		MESSAGEBOX("Attachment File is Missing or Invalid:";
			+CHR(13)+aAttachmentFiles[lnLoop],0,"Error")
		lnErrors=lnErrors+1
	ENDIF
ENDFOR

cSubject=ALLTRIM(lcSubject)
cBodyText=ALLTRIM(lcbodytext)

* Abort if an error has been found
IF lnErrors>0
	RETURN lnErrors
ENDIF

* Create the necessary objects to get to the message
loApplication=CREATEOBJECT("Outlook.Application")
loNameSpace=loApplication.GetNameSpace("MAPI")
loOutBox=loNameSpace.GetDefaultFolder(4)

* Create message object
oMessage=loOutBox.Items.Add
WITH oMessage
	.Body=cBodyText
	.Subject=cSubject
*	.MsgReceiptRequested=llReceipt
	* Normal recipients
	FOR lnLoop=1 TO ALEN(aRecipients,1)
		loRecipient=.Recipients.Add(aRecipients[lnLoop])
	ENDFOR
	* Copy recipients
	IF nCCRecipCount>0
		FOR lnLoop=1 TO ALEN(aCCRecipients,1)
			loRecipient=.Recipients.Add(aCCRecipients[lnLoop])
			loRecipient.Type=2
		ENDFOR
	ENDIF
	* Blind copy recipients
	IF nBCCRecipCount>0
		FOR lnLoop=1 TO ALEN(aBCCRecipients,1)
			loRecipient=.Recipients.Add(aBCCRecipients[lnLoop])
			loRecipient.Type=3
		ENDFOR
	ENDIF
	* Add any required attachment files
	IF lcattach = .t.
		IF NOT EMPTY(aAttachmentFiles[1])
			* Multiple attachment files
			FOR lnLoop=1 TO ALEN(aAttachmentFiles,1)
				.Attachments.Add(aAttachmentFiles[lnLoop])
			ENDFOR
		ENDIF
	ENDIF
	.Send()
	lcmailsent=.t.
	type1=.f.
	type2=.f.
ENDWITH
	loOutBox = NuLL
	Release loOutBox
	loNameSpace = Null
	Release loNamespace
	loapplication = null
	release loapplication

* Return 0 to indicate normal completion
RETURN 0
ENDPROC
Neil Lewis
IT R&D Manager
Velmore Ltd
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform