EmailOuvreSession(Utilisateur.Login_Mail,Utilisateur.MDP_Mail,Utilisateur.Serv_Pop,Utilisateur.Serv_Smtp)
SI ErreurDétectée ALORS
	Erreur("Impossible d'ouvrir la session.", ErreurInfo())
	RETOUR
FIN

Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
          Dim objOutlook As Outlook.Application
          Dim objOutlookMsg As Outlook.MailItem
          Dim objOutlookRecip As Outlook.Recipient
          Dim objOutlookAttach As Outlook.Attachment

          ' Create the Outlook session.
          Set objOutlook = CreateObject("Outlook.Application")

          ' Create the message.
          Set objOutlookMsg  = objOutlook.CreateItem(olMailItem)

          With objOutlookMsg
              ' Add the To recipient(s) to the message.
              Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
              objOutlookRecip.Type = olTo

              ' Add the CC recipient(s) to the message.
              Set objOutlookRecip = .Recipients.Add("Michael Suyama")
              objOutlookRecip.Type = olCC

             ' Add the BCC recipient(s) to the message.
              Set objOutlookRecip = .Recipients.Add("Andrew Fuller")
              objOutlookRecip.Type = olBCC

             ' Set the Subject, Body, and Importance of the message.
             .Subject = "This is an Automation test with Microsoft Outlook"
             .Body = "This is the body of the message." &vbCrLf & vbCrLf
             .Importance = olImportanceHigh  'High importance

             ' Add attachments to the message.
             If Not IsMissing(AttachmentPath) Then
                 Set objOutlookAttach = .Attachments.Add(AttachmentPath)
             End If

             ' Resolve each Recipient's name.
             For Each ObjOutlookRecip In .Recipients
                 objOutlookRecip.Resolve
             Next

             ' Should we display the message before sending?
             If DisplayMsg Then
                 .Display
             Else
                 .Save
                 .Send
             End If
          End With
          Set objOutlook = Nothing
      End Sub

//***********************************************************
//							INITIALISATIONS
//***********************************************************


//Définition des variables
m_OutLook est un objet OLE dynamique	// Objet "OutLook.Application"
m_NameSpace est un objet OLE dynamique	// Objet NameSpace, "MAPI"
m_Folder est un objet OLE dynamique		// Objet Folder, dossier OutLook
m_Item est un objet OLE dynamique		// Objet Item
m_numItemCourant est un entier			// N° de l'item en cours
sUtilisateur est une chaîne				// Nom de l'utilisateur
nTypeItem est un entier					// Type d'item manipulé : Calendrier, Note, Tâche, ...

sID est une chaîne				// Identifiant automatique géré par OutLook
sSujet est une chaîne			// Sujet
sContenu est une chaîne			// Contenu du message
sDateReception est une chaîne   // Date de réception
sHeureReception est une chaîne  // Heure de réception
sExpediteur est une chaîne		// Expéditeur
sDest est une chaîne			// Destinataire	
sDestCopie est une chaîne		// Destinataire	en copie
sDestCopieC est une chaîne		// Destinataire	en copie cachée
NbPiecesJointes est un entier
Tab_PiecesJointes est un tableau dynamique

QUAND EXCEPTION
	Erreur(ExceptionInfo(errRésumé))
	FinProgramme()
FIN

// Initialisation du dialogue avec OutLook
m_OutLook=ObjetActif("OutLook.Application")
SI m_OutLook=Null ALORS m_OutLook=allouer un objet OLE "OutLook.Application"
SI m_OutLook=Null ALORS
	Erreur("L'accès à OutLook par OLE a échoué.","Vérifiez que la version complète d'OutLook (pas ""OutLook Express""), livrée avec le pack Office, est bien installée.")
	FinProgramme()
FIN
m_NameSpace=m_OutLook>>GetNameSpace("MAPI")
SI m_NameSpace=Null ALORS
	Erreur("Erreur lors de la connexion au ""NameSpace"" MAPI.")
	FinProgramme()
FIN
sUtilisateur=m_NameSpace>>CurrentUser>>Name

// Se positionne sur le dossier OutLook demandé
m_Folder = m_NameSpace>>GetDefaultFolder(6)

//***********************************************************
//							ENVOI DE MAIL
//***********************************************************


Rep_PiecesJointes est une chaîne
i,j sont des entiers=0
libérer Tab_PiecesJointes

// Crée l'item dans OutLook
m_Item = m_OutLook>>CreateItem(0)

// Sujet
m_Item>>Subject = sSujet
// Contenu
m_Item>>Body = sContenu
// Destinataires
m_Item>>To = sDest
m_Item>>cc = sDestCopie
m_Item>>bcc = sDestCopieC

// Pièces jointes
POUR i=1 A NbPiecesJointes
	// Attachement du fichier au message dans OutLook
	m_Item>>Attachments>>Add(Rep_PiecesJointes+"\"+Tab_PiecesJointes[i])	
FIN

// Vérification des adresses des destinataires
SI PAS m_Item>>Recipients>>ResolveAll() ALORS
	// Affichage d'OutLook pour résolution du pb
	m_Item>>Display()
SINON
	// Envoi
	m_Item>>Send()
FIN

m_Item=Null

//***********************************************************
//							RECEPTION DE MAIL
//***********************************************************

i,j sont des entiers
libérer Tab_PiecesJointes

// Chargement des données depuis OutLook
Tab_PiecesJointes= allouer un tableau de 0 par 0 chaînes

// Parcours des items et appel de la méthode d'affectation(propre au type d'élément lu)
POUR i=1 A m_Folder>>items>>count
	m_Item = m_Folder>>Items>>Item(i)
	// Identifiant automatique géré par OutLook
	sID = m_Item>>EntryID
	// Sujet
	sSujet = m_Item>>Subject
	// Contenu
	sContenu = m_Item>>Body
	Info(sSujet+TAB+sContenu)
	// Récupération de la date et de l'heure
	sDateHeure est un DateHeure
	sDateHeure = m_Item>>ReceivedTime
	sDateReception = sDateHeure..Date
	SI PAS DateValide(sDateReception) ALORS sDateReception=""
	// Heure de réception
	sHeureReception=NumériqueVersChaine(sDateHeure..Heure,"02d")+NumériqueVersChaine(sDateHeure..Minute,"02d")
	// Récupération des adresses eMails des destinataires pour réponse
	objReply est un objet OLE dynamique = m_Item>>Reply
	SI PAS objReply=Null ALORS
		sExpediteur = objReply>>Recipients(1)>>Address
		libérer objReply
	FIN
	
	// Destinataires (e-Mails) pour réponse à tous
	objReplyAll est un objet OLE dynamique = m_Item>>ReplyAll
	sDestCourant, sNomDest, sEMailDest sont des chaînes
	sDestCourant = Remplace(m_Item>>to,"'","")
	k est un entier
	POUR k=1 A objReplyAll>>Recipients>>Count
		sEMailDest=objReplyAll>>Recipients(k)>>Address
		sNomDest=objReplyAll>>Recipients(k)>>Name
		SI PAS sNomDest~=sUtilisateur ALORS	// Ignore l'utilisateur en cours
			SI PAS sEMailDest~=sDestCourant ALORS	// Ignore l'eMail de l'utilisateur en cours
				SI PAS sEMailDest~=sExpediteur ALORS		// Ignore l'expéditeur
					SI PAS sDest~="" ALORS sDest+="; "
					sDest+=sEMailDest
				FIN
			FIN
		FIN
	FIN
	libérer objReplyAll
	
	// Copie / Copie cachée
	sDestCopie = m_Item>>cc
	sDestCopieC = m_Item>>bcc
	
	// Pièces jointes
	NbPiecesJointes = m_Item>>Attachments>>count
	Dimension(Tab_PiecesJointes,m_Folder>>items>>count,NbPiecesJointes)
	POUR j=1 A NbPiecesJointes
		Tab_PiecesJointes[i,j] = m_Item>>Attachments(j)>>FileName
	FIN
FIN