1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196
| <script type="text/vbscript">
'
' 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
'
' FremyCompany a ajouté : {
' Pour un navigateur web :
window.open(HyperLien)
' }
' 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
</script> |
Partager