Envoie de mail par macro sous excel

_______________________1______________________________
# '
# ' Ce module permet l'envoi automatique d'un mail
# ' par le logiciel client SMTP par défaut du système
# '
# ' le principe est de créer un lien de type "mailto:"
# ' et de demander au programme appelant de suivre ce lien
# '
# ' Les arguments Adresse, Objet et Corps sont fournis à la procédure
# ' qui les utilise pour définir l'hyperlien qui sera activé par la méthode
# ' FollowHyperLink du classeur actif
# '
# ' le problème est que VB suit le lien
# ' (ici il lance le programme de messagerie en lui fournissant
# ' les infos nécessaires)
# ' puis se désintéresse du problème
# ' c'est donc à l'utilisateur de finir le travail :
# ' choix éventuel de la pièce jointe et envoi du message.
# '
# ' pour automatiser complètement le processus,
# ' on utilise une méthode un peu simpliste mais efficace :
# ' simuler l'appui sur les touches à utiliser pour envoyer le message
# ' à l'aide de l'instruction SendKeys.
# ' en temporisant les envois successifs de touches, on y arrive bien
# '
# ' Inconvénient de la méthode :
# ' chaque logiciel de messagerie utilise ses propres
# ' menus (donc touches) pour joindre un fichier et envoyer le message
# ' par exemple pour Outlook Express : menu Intsertion (touche:Alt-I)
# ' puis le sous menu Pièce (touche : P)
# ' et l'envoi du message se fait par Alt-Entrée
# '
# ' pour pallier à cet inconvénient, je propose de stocker dans 2 tableaux
# ' TouchesPJ() et TouchesEnvoi()
# ' l'enchaînement de touches à utiliser par chaque client messagerie
# ' je fournis ici l'initialisation des tableaux pour les 3 clients
# ' dont je dispose sur ma machine :
# ' Mozilla ThunderBird,
# ' Outlook Express,
# ' et Office 2003 Outlook
# ' il suffit donc d'activer l'initialisation qui va bien
# ' pour le client utilisé.
# ' on pourrait aller gratter dans la base de registre pour le trouver
# ' mais outre que si on tombe sur un logiciel de messagerie
# ' un peu exotique et non prévu dans notre liste, on est mal,
# ' surtout cela compliquerait un programme sans prétention
# ' mais qui est simple et accessible à tous
# '
# ' Bon, assez parlé, un peu de code maintenant
# ' ------------------------------------------------------------------
# Option Explicit
# ' ------------------------------------------------------------------
# 'Déclaration des tableaux qui recevront les touches à utiliser suivant
# ' le logiciel de messagerie par défaut du système.
# ' Déclarés ici, les tableaux ont une portée qui couvre tout le module
# Dim TouchesPJ(5) As String, TouchesEnvoi(5) As String
#
# ' ------------------------------------------------------------------
# ' Procédure principale qui compose les éléments du message
# ' et effectue la demande d'envoi
# ' c'est cette procédure qui sera appelée par le programme principal
# ' (ici Excel)
# '
# Sub EnvoiEmail(Adresse As String, Objet As String, Corps As String, Optional PJ As String)
# ' Remarque : l'argument PJ (pièce jointe) est optionnel. S'il est fourni,
# ' c'est le chemin complet du fichier à joindre qui doit être fourni
# ' pour joindre plusieurs pièces, il faudrait que PJ soit
# ' un tableau et qu'il soit traité + bas par une boucle...
# Dim HyperLien As String ' Reçoit les éléments de l'hyperlien
# ' composés avec les arguments fournis
# Dim i As Integer ' un compteur
# Dim Client As Integer
# ' la syntaxe de base du mailto est la suivante :
# ' mailto:dest@domaine?Subject=sujet du message&Body=corps du message
# ' je ne prends pas en compte les copies, copies cachées
# ' ou autres confirmation de lecture, je suppose
# ' qu'il faudrait utiliser d'autre arguments de mailto...
#
# HyperLien = "mailto:" & Adresse & "?"
# ' Le ? introduit les arguments
# HyperLien = HyperLien & "Subject=" & Objet & " (à " & Time() & ")"
# HyperLien = HyperLien & "&Body=" & Corps
# ' le & sépare les arguments
#
# ' Activation du lien
# '
# ' Pour Excel (les autres doivent être en commentaire)
# ActiveWorkbook.FollowHyperlink HyperLien
# ' Pour Word (les autres doivent être en commentaire)
# ' ThisDocument.FollowHyperlink HyperLien
# ' Pour Access (les autres doivent être en commentaire)
# ' Application.FollowHyperlink HyperLien
#
# Attendre 5 ' Appel d'une procédure qui temporise
# ' c'est à dire que la procédure courante
# ' (ici EnvoiEmail) est suspendue pendant 5s
# ' cela permet d'Attendre que le client
# ' de messagerie soit lancé et prêt
# ' avant d'envoyer les touches
# ' sinon ce serait le programme appelant
# ' (ici Excel) qui recevrait les touches
#
# Client = 1 ' 1=Outlook Express
# ' 2=Mozilla Thunderbird
# ' 3=Office Outlook
#
# Select Case Client ' appel du chargement des tableaux des touches
# ' selon le client de messagerie indiqué
# Case 1
# OutLookExpress
# Case 2
# MozillaThunderbird
# Case 3
# Office2003OutLook
# Case Else
# MsgBox "Aucun client de messagerie connu n'est indiqué"
# Exit Sub
# End Select
#
# ' Le traitement de la pièce jointe ne s'exécute
# ' que si la procédure à reçu qqchose
# ' dans l'argument PJ (Optional<=>Facultatif)
#
# If PJ <> "" Then
# ' dans TouchesPJ(0) on a stocké le nombre de touches
# ' à envoyer au programme pour joindre une pièce
# For i = 1 To TouchesPJ(0) ' pour chaque touche à envoyer
# SendKeys TouchesPJ(i), True ' Envoi de la touches
# Attendre 1 ' temporise (à règler éventuellement)
# Next i
# SendKeys PJ, True 'A ce stade le programme attend un nom de fichier
# ' on lui envoie
# Attendre 1 ' on temporise
# SendKeys "{ENTER}", True ' et on valide ce nom de fichier
# Attendre 1
# End If
# For i = 1 To TouchesEnvoi(0) ' idem pour les touches d'envoi
# ' du message
# SendKeys TouchesEnvoi(i), True
# Next i
# ' Fin de la procédure principale
# End Sub
# ' -----------------------------------------------------------------
# Sub Attendre(Secondes As Integer)
# ' Cette procédure temporise pendant le nombre
# ' de secondes qu'on lui transmet en argument
# Dim Début As Long, Fin As Long, Chrono As Long
# Début = Timer
# Fin = Début + Secondes
# Do Until Timer >= Fin
# DoEvents
# Loop
# End Sub
#
#
# Sub OutLookExpress()
# 'Initialisation des tableaux de touches pour Outlook Express
# ' Pour une pièce jointe
# TouchesPJ(0) = 2 ' Nombre de touches nécessaires
# TouchesPJ(1) = "%i" ' Appel du menu Insertion par la touche Alt-i
# TouchesPJ(2) = "p" ' appel du sous-menu pièce par la touche p
# ' Pour l'envoi du mail
# TouchesEnvoi(0) = 1 ' Nombre de touches nécessaires
# TouchesEnvoi(1) = "%s" ' Envoi du message avec Alt-s
# End Sub
#
# Sub MozillaThunderbird()
# 'Initialisation des tableaux de touches pour Mozilla Thunderbird
# ' Pour une pièce jointe
# TouchesPJ(0) = 3 ' Nombre de touches nécessaires
# TouchesPJ(1) = "%f" ' Appel du menu Fichier par la touche Alt-f
# TouchesPJ(2) = "j" ' appel du sous-menu Joindre par la touche j
# TouchesPJ(3) = "f" ' sous-sous-menu Fichier par la touche f
# ' Pour l'envoi du mail
# TouchesEnvoi(0) = 2 ' Nombre de touches nécessaires
# TouchesEnvoi(1) = "^{ENTER}" ' Envoi du message avec Ctrl-Entrée
# TouchesEnvoi(2) = "{ENTER}" ' confirmation par Entrée
# End Sub
#
# Sub Office2003OutLook()
# 'Initialisation des tableaux de touches pour Office Outlook
# ' Pour une pièce jointe
# TouchesPJ(0) = 2 ' Nombre de touches nécessaires
# TouchesPJ(1) = "%i" ' Appel du menu Insertion par la touche Alt-i
# TouchesPJ(2) = "f" ' appel du sous-menu fichier par la touche f
# ' Pour l'envoi du mail
# TouchesEnvoi(0) = 1 ' Nombre de touches nécessaires
# TouchesEnvoi(1) = "%v" ' Envoi du message avec Alt-v
# End Sub



____________________2_________________________________
# '//TRES IMPORTANT: il faut faire un regsrv de la Dll de Notes qui n'est pas forcément identifié par VB
# '(ex: DEMARRER > EXECUTER puis "regsrv32 C:\progra~1\Lotus\Notes\nlsxbe.dll" (modifier en fonction du chemin de votre
# 'lotus)
#
# '//AJOUTER LA REFERENCE SUIVANTE ("projet > reference"): LOTUS DOMINO OBJECTS (qui correspond à domobj.tbl)
# '*************************************************************************************************************
# Function prvSendNotesMail(Subject As String, Attachment As String, Recipient As String, BodyText As String, SaveIt As Boolean) As Boolean
# '*********************************************
# 'Repris et développé par EvilGost
# 'Subject: Sujet du mail / Attachment: Chemin complet du fichier à attacher (ex: "C:\test.txt"), sinon, mettre "" /
# 'Recipient: Destinataire (ex: "jeanlouis@wanadoo.fr") / Bodytext: Texte du mail / SaveIt: sauvegarde du mail dans les courriers envoyés
# '*************************************************************************************************************
# 'Set up the objects required for Automation into lotus notes
# Dim Maildb As NotesDatabase 'The mail database
# Dim UserName As String 'The current users notes name
# Dim MailDoc As Object 'The mail document itself
# Dim AttachME As Object 'The attachment richtextfile object
# Dim oSession As NotesSession
# Dim dbDirectory As NotesDbDirectory
# Dim EmbedObj As Object 'The embedded object (Attachment)
#
# On Error GoTo ErrHandle
#
# Set oSession = New NotesSession
# 'Démarre une session de notes
# 'La ligne suivante ne marche qu'avec les versions 5.x et 6.x , c'est l'injection du mot de passe
#
# oSession.Initialize ("Mot de passe")
#
# 'Récupère le nom par défaut de la session
# UserName = oSession.UserName
#
# 'Ouvre la base mail en utilisant le serveur par défaut
# Set dbDirectory = oSession.GetDbDirectory("") 'vous pouvez mettre l'adresse du serveur dans ces parentheses
# Set Maildb = dbDirectory.OpenMailDatabase
#
# 'Création du formulaire d'envoi de mail
# Set MailDoc = Maildb.CreateDocument()
#
# MailDoc.AppendItemValue "Subject", Subject 'remplissage du Sujet
# MailDoc.AppendItemValue "SendTo", Recipient 'si vous passer un tableau de string() en paramètre, vous pouvez mettre plusieurs destinataire (ex: Recipient(2))
# MailDoc.AppendItemValue "Body", BodyText 'Corps du mail
#
# 'Permet d'attacher un document au mail
# If Attachment <> "" Then
# Set AttachME = MailDoc.CreateRichTextItem("Attachment")
# Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
# End If
#
# 'Envoi le document
#
# If SaveIt = True Then
# MailDoc.SaveMessageOnSend = SaveIt 'si à True, Lotus sauvegarde le mail envoyé
# End If
#
# Call MailDoc.Send(False) 'j'obtiens une erreur lorsque je mets true au lieu de false, si quelqu'un sait pourquoi
#
# prvSendNotesMail = True
# GoTo ExitHandle
#
# ErrHandle:
# Msgbox Err.Description
# prvSendNotesMail = false
#
# ExitHandle:
# 'Vidage mémoire
# Set Maildb = Nothing
# Set MailDoc = Nothing
# Set AttachME = Nothing
# Set oSession = Nothing
# Set dbDirectory = Nothing
# Set EmbedObj = Nothing
# End Function

On m'a envoyé ces deux fichier ca marche sans reponses de votre part.