I got the following code from Marcia Akins et al cntMapi class which I modified to send PDF document by email. The client uses Outlook and would like to change the Default Email Account in the FoxPro code without user intervention and set back to the original at the end of processing.
I want to know, also, if I change the Email Client to Mail if the output will be sent to Mail Outbox, and if this can done programmatically.
Send Routine
- This class is for Consoft payroll only/see text file version code in turbopay8 folder --> sendmail.prg
Email .pdf file
enter code here
LOCAL lcBDPE, lcAttachment, lcCurDir, lnSessionID, lnFile, lnCnt, lnPos, myvar, pcycle, lcPath ,llError,lcDcode,; lcSec,lcMessage,lnLen,lcOldError,lcObj,lcCentury,laMail[1] SET STEP ON lcCurDir = FULLPATH( CURDIR() ) lcPath = SET("PATH") SET PATH TO &lcCurDir lcCentury = SET("Century") SET CENTURY ON lcPayslipfile = ''
*** Make sure we have a MAPI session established
IF !EMPTY(pycntrl.mailclient) oSendparms.cUsername = TRIM(pycntrl.mailclient) ELSE oSendparms.cUsername = "" ENDIF oSendparms.cPassword = "" oSendparms.lDownload = .F.
DO CASE CASE UPPER(pycntrl.cycle) = "W" pcycle = "week" CASE UPPER(pycntrl.cycle) = "F" pcycle = "fortnight" CASE UPPER(pycntrl.cycle) = "B" pcycle = "bi-monthly cycle" CASE UPPER(pycntrl.cycle) = "M" pcycle = "month" ENDCASE
lnSessionID = THIS.CreateSession( oSendparms.cUserName, oSendparms.cPassWord, oSendparms.lDownload )
IF lnSessionID > 0 *** Create message and send it WITH THIS.oMessage .SessionID = lnSessionID SET PRINTER TO NAME 'BULLZIP PDF PRINTER' WAIT 'Salary deduction notifications are being mailed.' WINDOW NOWAIT NOCLEAR
SELECT driver SCAN lcDcode = code lcAttachment = '' *----------------------------------------------------------------------------------------------NEW CODE
lcMessage = 'An error occurred when sending deduction notification.'+CHR(13)+; 'An attempt to reset the default PDF file failed'+CHR(13)+; 'Please close the PDF file if is in opened'+CHR(13)+; 'The program will terminate.'
lcOldError = ON("ERROR") ON ERROR llError = .T. IF ADIR(laMail,lcPayslipfile) = 1 ERASE (lcPayslipfile) IF llError = .T. =MESSAGEBOX(lcMessage, 16, 'Salary Deduction Notification' ) CANCEL ENDIF ENDIF llError = .F. ON ERROR &lcOldError
lcPayslipfile = Textmerge('c:\email\DeductionNotification<>.pdf')
- Create the COM object to control the printer. lcObj = CreateObject("BullZIP.PDFPrinterSettings") lcObj.SetValue("Output",lcPayslipfile)
- lcObj.SetValue("WatermarkText" ,"Draft")
- lcObj.SetValue("WatermarkColor","#FF9900") lcObj.SetValue("ShowSettings" ,"never") lcObj.SetValue("ShowPDF" ,"no") lcObj.WriteSettings(.t.)
IF !EMPTY(glAll) SELECT d.empno,namel,namef,name AS institution,desc AS deduction,d.code,per,p.email FROM pyemdedw d ; JOIN pyemplw m ON d.empno = m.empno ; JOIN pydedn p ON d.code = p.code ; WHERE per > 0 AND !EMPTY(p.email); AND d.code = lcDcode; ORDER BY namel,namef,deduction; INTO CURSOR dedmail ENDIF
IF !EMPTY(gcDcode) SELECT d.empno,namel,namef,name AS institution,desc AS deduction,d.code,per,p.email FROM pyemdedw d ; JOIN pyemplw m ON d.empno = m.empno ; JOIN pydedn p ON d.code = p.code ; WHERE per > 0 AND !EMPTY(p.email); AND d.code = gcDcode; ORDER BY namel,namef,deduction; INTO CURSOR dedmail ENDIF
- oGv.pcReportTitle = dedmail.deduction REPORT FORM institutiondeductions NOCONSOLE TO PRINTER
lcMessage = 'The creation of the attachment is taking too long.'+CHR(13)+; 'Ask your administrator to reset the name of the PDF file'+CHR(13)+; 'in the Bullzip utility interface to c:\email\payslip.pdf'+CHR(13)+; 'if it was changed. The program will terminate.'
lcSec = SECONDS() *DECLARE Sleep IN kernel32 INTEGER dwMilliseconds DO WHILE NOT ADIR(laMail,lcPayslipfile) = 1 *Sleep(5000) IF SECONDS() - lcSec > 35 =MESSAGEBOX(lcMessage, 16, 'Salary Deduction Notification') CANCEL ENDIF ENDDO
*----------------------------------------------------------------------------------------------
lcMessage = 'The attachment ID does not match the institution being processed.'+CHR(13)+; 'The program will terminate.'
lnLen = LEN(lcPayslipfile) - 4 *IF UPPER(SUBSTR(lcPayslipfile,22,lnLen - 21 - 8)) == UPPER(TRIM(driver.empno)) lcAttachment = (lcPayslipfile) *ELSE
- =MESSAGEBOX(lcMessage, 16, 'Non-Statutory Deductions Notification')
- CANCEL *ENDIF
oSendparms.aRecipients(1,1) = ALLTRIM(driver.email) oSendparms.aRecipients(1,2) = 1 oSendparms.aAttachments(1) = lcAttachment oSendparms.cSubject = "Salary Deductions Notification for "+ALLTRIM(driver.name)
myvar = "" SET TEXTMERGE ON NOSHOW SET TEXTMERGE TO MEMVAR myVar
\TO: <> \ \Attached is the salary deduction listing showing payments made for <> ending <>. \ \FROM: <>
SET TEXTMERGE TO SET TEXTMERGE OFF
oSendparms.cBodytext = myvar
.Compose() *** Make sure we have enough room to add the attachments on to the end of the body .MsgNoteText = oSendparms.cBodyText + CHR(13) + CHR(13) + ; SPACE( ALEN( oSendparms.aAttachments, 1 ) + 2 ) .MsgSubject = oSendparms.cSubject
* Add the recipients * The e-mail address is column 1 *** The recipient type is column 2 FOR lnCnt = 1 TO ALEN( oSendparms.aRecipients, 1 ) .RecipIndex = .RecipCount .RecipDisplayName = ALLTRIM( oSendparms.aRecipients[ lnCnt, 1 ] ) .RecipType = oSendparms.aRecipients[ lnCnt, 2 ] ENDFOR
* Finally add the attachments * find the correct position for the first one lnPos = LEN( oSendparms.cBodyText ) + 3 IF NOT EMPTY( oSendparms.aAttachments[ 1 ] ) FOR lnCnt = 1 TO ALEN( oSendparms.aAttachments, 1 ) .AttachmentIndex = .AttachmentCount .AttachmentPosition = lnPos .AttachmentName = JUSTFNAME( ALLTRIM( oSendparms.aAttachments[ lnCnt ] ) ) .AttachmentPathName = ALLTRIM( oSendparms.aAttachments[ lnCnt ] ) lnPos = lnPos + 1 ENDFOR ENDIF
* All systems go: send the e-mail * An argument of 1 will open client to manually send composed message
.Send(0)
ENDSCAN ENDWITH
*** Sign off IF ADIR(laMail,lcPayslipfile) = 1 ERASE (lcPayslipfile) ENDIF
SET PRINTER TO DEFAULT WAIT CLEAR This.oSession.SignOff() ELSE SET DEFAULT TO ( lcCurDir ) && Default directory SET PATH TO &lcPath SET CENTURY &lcCentury MESSAGEBOX( 'Unable to create MAPI Session', 16, 'Major WAAAHHH!' ) RETURN .F. ENDIF SET DEFAULT TO ( lcCurDir ) && Default directory SET PATH TO &lcPath SET CENTURY &lcCentury