*===================================================================== * MIME file Menu * * create the program as follow: * * CRTPGM MMAIL/CUSTMAIL MODULE(MMAIL/CUSTMAIL MMAIL/LIBRNAME) ACTGRP(*CALLER) * *===================================================================== /copy MMAIL/qrpglesrc,hspecs /copy MMAIL/qrpglesrc,hspecsbnd * Customer file Fcontacts if a e k disk usropn * Display file Fcustmail cf e workstn usropn F sfile(sfl:line) /copy MMAIL/qrpglesrc,mailproto /copy MMAIL/qrpglesrc,prototypeb /copy MMAIL/qrpglesrc,variables3 /copy MMAIL/qrpglesrc,usec D librname s 10 D mmaildata s 10 inz('MMAILDATA') D AddSW s 1 D Howmany s 10i 0 D MsgStmf s 512 * The following is the "mother letter" to be customized D templateStmf s 512 D MimeSName s 50 D MimeSEmail s 50 D ToNameArr s 50 dim(1000) D ToAddrArr s 256 dim(1000) D ToDistArr s 10i 0 dim(1000) D TxtVarArr s 10 dim(500) D TxtValArr s 500 dim(500) * Variables used by subprocedure SendMail D CpfID s 7 D FromAddr s 255 D JobCCSIDs s 10 D ever s 10i 0 *===================================================================== * Main line *===================================================================== * If needed, set the CCSID of the current job and of the QMSF jobs to the job default CCSID C callp setDftCCSID * Retrieve data area *LIBL/LIBRNAME C eval librname=rtvLibrName * Fill array "TxtVarArr" with the &variable_names * contained in the IFS text file "TemplateStmf". C eval TemplateStmf='/' + %trim(librname) + C '/mime/custmail.txt' C exsr SetTxtVar * C exsr DoOpen C exsr LoadSfl C DOW ever=0 do it forever C write foot C eval *in90 = *off C eval *in70 = *on C exfmt ctl * C if *in03 or *in12 C exsr Exit C endif * C exsr DoAdd C if AddSW <> ' ' C exsr LoadSfl C iter C endif * C if *in23 C exsr ClrConta C exsr LoadSfl C iter C endif * C if *in10 C exsr SendNow C endif * C ENDDO *===================================================================== * Set the names of the variables (to be substituted in the MIME text) * (In this program, we just need one variable, named "&1", that will * be replaced by the full name of the customer: * dspf '/mmail/mime/custmail.txt' ) *===================================================================== C SetTxtVar begsr C eval TxtVarArr(1) = '&1' C endsr *===================================================================== * Load subfile *===================================================================== C Loadsfl begsr * C eval line = 0 C eval *in70 = *off C eval *in71 = *off C write ctl * C eval contaemail = *loval C contaemail setll contarcd C read contarcd C dow not%eof C eval *in71 = *on C eval line = line +1 C eval fullname = %trim(contafname) + ' ' + C %trim(contalname) C write sfl C if contaemail = contaemain C eval linepos = line C endif C read contarcd C enddo * C eval linelst = line C if linepos<1 or linepos>linelst C eval linepos = 1 C endif C eval contaemain = ' ' C eval contafnamn = ' ' C eval contalnamn = ' ' * C endsr *================================================================== * Add customer record *================================================================== C DoAdd begsr C eval AddSW = ' ' C if contaemain <> ' ' and C contafnamn <> ' ' and C contalnamn <> ' ' C eval contaemail = contaemain C eval contafname = contafnamn C eval contalname = contalnamn C write contarcd C eval AddSW = 'x' C endif C endsr *================================================================== * Clear the customer file *================================================================== C ClrConta begsr * Close database file CONTACTS C if %open(CONTACTS) C close contacts C eval rc=docmd('dltovr CONTACTS lvl(*job)') C endif * Clear database file CONTACTS C eval rc=docmd('chkobj ' + %trim(mmaildata) + '/' + C 'CONTACTS *file') C if rc=0 C eval rc = doCmd('clrpfm ' + %trim(mmaildata) + C '/contacts') C else C eval rc = doCmd('clrpfm ' + %trim(librname) + C '/contacts') C endif * Open database file CONTACTS C IF not %open(CONTACTS) C eval rc=docmd('chkobj ' + %trim(mmaildata) + '/' + C 'CONTACTS *file') C if rc=0 C eval rc=docmd('ovrdbf CONTACTS ' + C %trim(mmaildata) + '/CONTACTS + C secure(*yes) ovrscope(*job)') C else C eval rc=docmd('ovrdbf CONTACTS ' + C %trim(librname) + '/CONTACTS + C secure(*yes) ovrscope(*job)') C endif C open CONTACTS C ENDIF * C endsr *================================================================== * Send customized letters, one to each customer *================================================================== C SendNow begsr * 1- Ask sender's data C DOW ever=0 do it forever C exfmt sndrfmt C if *in03 C exsr Exit C endif C if *in12 C leavesr C endif C if sndrname=' ' or sndremail=' ' C iter C endif C leave C ENDDO * 2- Send the customized letters C eval howmany = 0 C eval contaemail = *loval C contaemail setll contarcd * C read contarcd C dow not%eof C eval howmany = howmany +1 C exsr SendOne C read contarcd C enddo * Enable feedback message to be displayed C eval fdbmessage = '* ' + C %trim(%editc(howmany:'Z')) + C ' customized letters have been sent.' C eval *in90 = *on * C endsr *================================================================== * Send one customized letter *================================================================== C SendOne begsr * Create the substitution value for the text variable C eval TxtValArr(1) = %trim(contafname) + ' ' + C %trim(contalname) * Create the temporary MIME file to be sent C eval MsgStmf=TempCrtF * Add "Sender" header C eval MimeSName = sndrname C eval MimeSEMail= sndremail C callp MimeSender(MsgStmf: C MimeSName:MimeSEmail) * Add "To" header C eval ToNameArr(1) = %trim(contafname) + ' ' + C %trim(contalname) C eval ToAddrArr(1) = %trim(contaemail) C eval ToDistArr(1) = 0 C callp MimeDistr(MsgStmf:ToNameArr: C ToAddrArr:ToDistArr) /free // Customize and append the template stream file to the message (MIME) stream file MimeUpdTxt(MsgStmf:TemplateStmf:TxtVarArr:TxtValArr); // Send the temporary MIME file FromAddr = sndremail; CpfID=SendMail(MsgStmf:FromAddr:ToAddrArr:ToDistArr); Endsr; /end-free *================================================================== * Open files *================================================================== C DoOpen begsr C eval rc = DoCmd('addlible ' + %trim(librname)) * Open display file CUSTMAIL C if not %open(CUSTMAIL) C eval rc=docmd('ovrdspf CUSTMAIL ' + C %trim(librname) + '/CUSTMAIL + C secure(*yes) ovrscope(*job)') C open CUSTMAIL C endif * Open database file CONTACTS C IF not %open(CONTACTS) C eval rc=docmd('chkobj ' + %trim(mmaildata) + '/' + C 'CONTACTS *file') C if rc=0 C eval rc=docmd('ovrdbf CONTACTS ' + C %trim(mmaildata) + '/CONTACTS + C secure(*yes) ovrscope(*job)') C else C eval rc=docmd('ovrdbf CONTACTS ' + C %trim(librname) + '/CONTACTS + C secure(*yes) ovrscope(*job)') C endif C open CONTACTS C ENDIF * C endsr *================================================================== * Close files *================================================================== C DoClose begsr * Close display file CUSTMAIL C if %open(CUSTMAIL) C close custmail C eval rc=docmd('dltovr CUSTMAIL lvl(*job)') C endif * Close database file CONTACTS C if %open(CONTACTS) C close contacts C eval rc=docmd('dltovr CONTACTS lvl(*job)') C endif * C endsr *================================================================== * Exit *================================================================== C Exit begsr C exsr DoClose C eval *inlr = *on C return C endsr