Envoi de mail

'Appel de la procédure qui envoit le mail avec le pdf

Call EnvoiEmail("email de la personne", nom du pdf, " ", emplacement du pdf dans les repertoires, , , False)

'**********************Envoi de mail******************

Dim TouchesPJ(5) As String, TouchesEnvoi(5) As String

Sub EnvoiEmail(Adresse As String, Objet As String, Corps As String, Optional PJ As String, Optional Cc As String, Optional Bcc As String, Optional Collage As Boolean)

Dim HyperLien As String ' Reçoit les éléments de l'hyperlien

' composés à partir des arguments fournis à la procédure

Dim i As Integer ' un compteur

Dim Client As Integer

' la syntaxe de base du mailto est la suivante :

' mailto:dest@domaine.bof?Subject=Le sujet du message _

&Body=Le corps du message _

&cc=Destinataire copie _

&bcc=Destinataire copie cachée

HyperLien = "mailto:" & Adresse & "?" ' Le ? introduit les arguments

HyperLien = HyperLien & "Subject=" & Objet

If Not Collage Then ' (en cas de collage, le corps est ajouté juste avant le collage)

HyperLien = HyperLien & "&Body=" & Corps ' le & sépare les arguments

End If

If Cc <> "" Then HyperLien = HyperLien & "&cc=" & Cc

If Bcc <> "" Then HyperLien = HyperLien & "&bcc=" & Bcc

' Activation du lien

'

'ActiveWorkbook.FollowHyperlink HyperLien ' Pour Excel (les autres doivent être en commentaire)

'ThisDocument.FollowHyperlink HyperLien ' Pour Word (les autres doivent être en commentaire)

Application.FollowHyperlink HyperLien ' Pour Access (les autres doivent être en commentaire)

Attendre 2 ' Appel d'une procédure qui temporise

' c'est à dire que la procédure courante

' (ici EnvoiMail) 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

' A REGLER selon votre config

' l'argument de FollowHyperlink se plante au delà de 817 caractères

' donc pour les long messages, on peut utiliser le copier/coller

' C'est le programme appelant qui effectue le COPIER

' (éventuellement même une copie de cellules en tant qu'image : Selection.CopyPicture)

' la présente procédure se contente de COLLER le contenu du presse-papier

' si l'arguement Collage est à True

If Collage Then

' colle puis insère le texte du message au début du message

SendKeys "+{INSERT}", True ' collage

SendKeys "^{HOME}", True ' début du message

SendKeys Corps, True ' envoi du corps du message

SendKeys "{Enter}", True ' ligne suivante

End If

Client = 6 ' 1=Outlook Express

' 2=Mozilla Thunderbird

' 3=Office Outlook

' Suivent des configurations pour d'autres clients de messagerie

' trouvées sur le forum

' 4=Une autre version pour Outlook2003

' 5=Incredimail

' 6=Office Outlook 2007

' 7=...à vous d'ajouter d'autres clients

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 4

Office2003OutLookV2

Case 5

Incredimail

Case 6

Office2007OutLook

Case 7

Office2000OutLook

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

For i = 1 To TouchesPJ(0) ' dans TouchesPJ(0) on a stocké le nombre de touches

' à envoyer au programme pour joindre une pièce

SendKeys TouchesPJ(i), True ' Envoie les touches d'ajout d'1 pièce jointe

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

'suite code mise en comment car pas envoi immédiat

'For i = 1 To TouchesEnvoi(0)

' SendKeys TouchesEnvoi(i), True ' on envoie le message

'Next i

End Sub

Public 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) = 4 ' Nombre de touches nécessaires

' il semble que l'appel par Alt-f du menu fichier ne marche pas

' à tous les coups donc (merci à FRED65200)

TouchesPJ(1) = "{F10}" ' Appel des menus par {F10}

TouchesPJ(2) = "f" ' Appel du menu Fichier par la touche f

TouchesPJ(3) = "j" ' appel du sous-menu Joindre par la touche j

TouchesPJ(4) = "f" ' appel du sous-sous-menu Fichier par la touche f

' Pour l'envoi du mail

TouchesEnvoi(0) = 4 ' Nombre de touches nécessaires

TouchesEnvoi(1) = "%xf" ' choisit l'expéditeur qui commence par F

' à changer bien sur pour votre cas perso

TouchesEnvoi(2) = "^{ENTER}" ' Envoi du message avec Ctrl-Entrée

TouchesEnvoi(3) = "{DOWN}" ' Flèche bas pour choisir l'option "Envoyer en HTML seul"

' dans la boite dialogue

TouchesEnvoi(4) = "{ENTER}" ' confirmation par Entrée

End Sub

Sub Office2003OutLook()

'Initialisation des tableaux de touches pour Office Outlook 2003

' 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

Sub Incredimail()

' Contribution de KOLOCO pour Incredimail

' Initialisation des tableaux de touches pour Incrédimail

' Pour une pièce jointe

TouchesPJ(0) = 1 ' Nombre de touches nécessaires

TouchesPJ(1) = "^+a" 'Appel du menu Insertion Fichier par la touche Ctrl+Shift+A

' Pour l'envoi du mail

TouchesEnvoi(0) = 1 ' Nombre de touches nécessaires

TouchesEnvoi(1) = "%s" 'Envoi du message avecAlt-s

End Sub

Sub Office2003OutLookV2()

' Version corrigée par CLARK1978 à essayer si la version d'origine ne gère pas

' la touche Alt-i correctement

' Initialisation des tableaux de touches pour Office Outlook 2003

' Pour une pièce jointe

TouchesPJ(0) = 3 ' Nombre de touches nécessaires

TouchesPJ(1) = "%a" 'Appel du menu Insertion par la touche Alt-a (affichage)

TouchesPJ(2) = "{RIGHT}" ' puis flèche à droite

TouchesPJ(3) = "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 avecAlt-v

End Sub

Sub Office2007OutLook()

' Contribution de PC512 pour Office 2007

' Initialisation des tableaux de touches pour Office Outlook 2007

' Pour une pièce jointe

TouchesPJ(0) = 2 ' Nombre de touches nécessaires

TouchesPJ(1) = "%s" ' Appel du menu Insertion par la touche Alt-i

TouchesPJ(2) = "jf" ' 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 avecAlt-v

End Sub

Sub Office2000OutLook()

' Contribution de TANATLOC92 pour Office Outlook 2000

' Initialisation des tableaux de touches pour Office Outlook 2000

' 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) = "^{ENTER}" ' Envoi du message avec Ctrl-Entrée

End Sub