ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

9 Solutions pour ouvrir un message e-mail soit avec Outlook Express ou Outlook.   


L'auteur

Mike Gagnon
Canada Canada
Membre Simple
# 0000000025
enregistré le 14/10/2004

Gagnon Mike
Pointe Cla H9R 3K8
de la société Carver Technologies Inc.
Fiche personnelle

Note des membres
pas de note

Contributions > 12 - Envoyer des Emails

9 Solutions pour ouvrir un message e-mail soit avec Outlook Express ou Outlook.
# 0000000047
ajouté le 05/11/2004 16:00:40 et modifié le 01/12/2005
consulté 18101 fois
Niveau débutant

Version(s) Foxpro :
VFP 7.0
Description
Dépendant du programme courriel qui est mis par défault, c'est celui-ci qui va s'ouvrir.
Code source :
&& Solution #1 Avec Microsoft Word
&& Deux lignes de code !
o = CREATEOBJECT('word.application')
o.Documents.Add("Normal",.f.,2)

&&Solution #2 Avec Internet Explorer

oIE = Createobject('internetexplorer.application')
oIE.navigate('about:blank')
Inkey(6)
oIE.Visible =.T.
sp=Createobject("Wscript.Shell")
sp.SendKeys('%F')
sp.SendKeys('E')
sp.SendKeys('l')  && Dépendant du besoin, cette option met un lien URL
* sp.SendKeys('p') && Dépendant du besoin, cette option met la page web dans le message

&&Solution #3 Avec Microsoft Excel

oExcel = CREATEOBJECT("excel.application")
owb = oExcel.workbooks.add()
owb.SendForReview('moi@quelquepart.net','Sujet',.t.)


&& Solution #4

DECLARE INTEGER ShellExecute IN shell32.dll ;
  INTEGER hndWin, STRING cAction, STRING cFileName, ;
  STRING cParams, STRING cDir, INTEGER nShowWin

lcMail = "mailto:toi@macompanie.com"+ ;
  "?CC= patron@macompanie.com&Subject= Rencontre"+ ;
   "&Body= Veuillez me rejoindre pour diner."
ShellExecute(0,"open",lcMail,"","",1)

&& Solution #5

oShellExec=NewObject("_shellexecute",Home(1)+"\ffc\_environ.vcx")
oShellExec.shellexecute("mailto:moe@howard.com?bcc=larry@fine.com&subject=test&body=body goes here")

&& Solution #6

DO FindWindow
LOCAL lcPath, hWindow, lcDelimiter, lcFiles, lcMsgSubj
lcPath = SYS(5) + SYS(2003)
hWindow = GetActiveWindow()
lcDelimiter = ";"
lcFiles = "C:\assisted.xls" && Doit etre un fichier valide.
lcMsgSubj = "Fichier Attachés: assisted.xls."
= MAPISendDocuments (hWindow, lcDelimiter, lcFiles, lcMsgSubj, 0)
SET DEFAULT TO (lcPath)
PROCEDURE  FindWindow
    DECLARE INTEGER GetActiveWindow IN user32
    DECLARE INTEGER MAPISendDocuments IN mapi32;
        INTEGER ulUIParam, STRING lpszDelimChar,;
        STRING lpszFullPaths, STRING lpszFileNames,;
        INTEGER ulReserved
ENDPROC

&& Solution #7

email("mike@nowhere.com","boss@mycompany.com")
Function email
Lparameters cUrlto,cUrlcc
cFile = Sys(2023) + Sys(3) + '.URL'
If File(m.cFile)
    Erase (m.cFile)
Endif
nFh = Fcreate(m.cFile)
If m.nFh < 0
    Wait "Can't create a temporary file for the email" Window Nowait
    Return
Endif
= Fputs(m.nFh,'[InternetShortcut]')
= Fwrite(m.nFh,'URL=mailto:' + cUrlto)
= Fwrite(m.nFh,"?CC= &cUrlcc&Subject= Meet for lunch&Body=Please join me and the gang for lunch tomorrow")
= Fflush(m.nFh)
= Fclose(m.nFh)
Run /N2 Start &cFile
Return .T.
Endfunc


&& Solution #8 Comment ouvrir Outlook Express avec CC et BCC ET attachement pret à envoyer. Pour faire fonctionner avec Outlook Express, il faut que dans Internet Explorer, Outlook Express soit mis comme programme par défaut pour envoyer les courriels, sinon la technique fonctionnera, mais avec le programme qui est mis par défault.

Dimension aryAttach(1) && Add as many elements (attachments) as you like
Local lcFrom, lcTo, lcSubject, lcBody, lnCount, lcCC, lcBCC, lcUserName, lcPassword, llEmailStatus, lcErrorHandlerWas
***** Replace the following with real values to run this example********
aryAttach(1) = "C:\done.txt" && File to attach, add more if needed
lcFrom = "me@somewhere.net"
lcTo = "you@somewhere.net"
lcCC = "mv@met.com"
lcBCC = "mv2@met.com"
lcUserName = "" && Only if required by default smtp server
lcPassword = "" && Only if required by default smtp server
*************************************************************
lcSubject = "VFP Email Via MAPI"
lcBody = "MAPI seems to work pretty good."
lcErrorHandlerWas = On("ERROR")
Wait Window " One Moment... Email is being generated and sent " Nowait

llEmailStatus = SendViaMAPI(lcFrom, lcTo, lcSubject, lcBody, @aryAttach, lcCC, lcBCC, lcUserName, lcPassword)
On Error &lcErrorHandlerWas
Wait Clear
If llEmailStatus
  Messagebox("Your message to " + lcTo + " has been sent.",64,"EMAIL SENT SUCCESSFULLY VIA MAPI")
Else
  Messagebox("Your message to " + lcTo + " was not sent.",64,"EMAIL PROBLEM WITH MAPI")
Endif

**********************************************************************
Function SendViaMAPI(tcFrom, tcTo, tcSubject, tcBody, taFiles, tcCC, tcBCC, tcUserName, tcPassword)
**********************************************************************
  #Define Primary 1
  #Define CARBON_COPY 2
  #Define BLIND_CARBON_COPY 3
  Local loSession, loMessages
  On Error Return(.F.)
  loSession = Createobject("MSMAPI.MAPISession")
  If Type('tcUserName') = 'C'
    loSession.UserName = tcUserName
  Endif
  If Type('tcPassword') = 'C'
    loSession.Password = tcPassword
  Endif
  loSession.Signon()
  If (loSession.SessionID > 0)
    loMessages = Createobject( "MSMAPI.MAPIMessages" )
    loMessages.SessionID = loSession.SessionID
  Endif
  With loMessages
    .Compose()
    .RecipDisplayName = tcTo
    .RecipType = Primary
    .ResolveName()
    If Type("tcCC") = "C" And !Empty(tcCC)
      .RecipIndex = .RecipCount
      .RecipDisplayName = tcCC
      .RecipType = CARBON_COPY
      .ResolveName()
    Endif
    If Type("tcBCC") = "C" And !Empty(tcBCC)
      .RecipIndex = .RecipCount
      .RecipDisplayName = tcBCC
      .RecipType = BLIND_CARBON_COPY
      .ResolveName()
    Endif
    If Type('taFiles',1) = "A"
      For lnCountAttachments = 1 To Alen(taFiles)
        .AttachmentIndex = .AttachmentCount
        .AttachmentPathName = taFiles(lnCountAttachments)
      Endfor
    Endif
    .MsgSubject = tcSubject
    .MsgNoteText = tcBody
    .Send(.T.)
  Endwith
  loSession.Signoff()
  Store .Null. To loSession, loMessages
  Release loSession, loMessages
  Return .T.
Endfunc

&& 9 Comment ouvrir un courriel avec WinExec

Local lcTo, lcSubject, lcBody, lcCC, lcBCC, lcErrReturn
lcTo = "someone@somewhere.com"
lcSubject = "Hey Have You Tried VFP Email?"
lcBody = "Just wanted to let you know that VFP is pretty versatile" + Chr(13) + "and has a lot of ways to send email."
lcCC = "someoneelse@anotherhost.com"
lcBCC = "myboss@boss.com"

SendViaWinExec(@lcErrReturn, lcTo, lcSubject, lcBody, lcCC, lcBCC)

If Empty(lcErrReturn)
  Messagebox("'" + lcSubject + "' opened successfullly.", 64, "Send email via WinExec")
Else
  Messagebox("'" + lcSubject + "' failed to be sent. Reason:" + Chr(13) + lcErrReturn, 64, "Send email via WinExec")
Endif

*******************************************
Procedure SendViaWinExec(tcReturn, tcTo, tcSubject, tcBody, tcCC, tcBCC)
*******************************************

Declare Integer WinExec In kernel32 ;
  STRING lpCmdLine ,;
  INTEGER uCmdShow

Local lcCommand, lcCRLF

Try
  lcCRLF = "%0D%0A"
  lcCommand = ["C:\Program Files\Outlook Express\msimn.exe" /mailurl:mailto:] + tcTo + "?Subject=" + tcSubject + "&Body=" + Strtran(tcBody, Chr(13), lcCRLF)
  If Type("tcCC") = "C"
    lcCommand = lcCommand + "&CC=" + tcCC
  Endif
  If Type("tcBCC") = "C"
    lcCommand = lcCommand + "&BCC=" + tcBCC
  Endif
  If Len(lcCommand) > 32766 && should be 32768, but not on my system
    Throw "Mailto command is limited to 32768 bytes"
  Endif

  WinExec(lcCommand, 1)

Catch To loError
  tcReturn = [Error: ] + Str(loError.ERRORNO) + Chr(13) + ;
    [LineNo: ] + Str(loError.Lineno) + Chr(13) + ;
    [Message: ] + loError.Message + Chr(13) + ;
    [Procedure: ] + loError.Procedure + Chr(13) + ;
    [Details: ] + loError.DETAILS + Chr(13) + ;
    [StackLevel: ] + Str(loError.STACKLEVEL) + Chr(13) + ;
    [LineContents: ] + loError.LINECONTENTS
Finally
  Clear Dlls "WinExec"
Endtry
Endproc
Commentaires
le 28/01/2008, Alain Blanchard a écrit :
Merci pour tous Mike
Publicité

Les pubs en cours :
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3