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
| Option Explicit
Dim TouchesPJ(5) As String, TouchesEnvoi(5) As String
'1 seule pièce jointe
Sub EnvoiEmail(Adresse As String, Objet As String, Corps As String, Optional pj As String, Optional Cc As String, Optional Bcc As String)
Dim HyperLien As String 'déclare la variable Hyperlien
Dim i As Integer 'déclare la variable i
Dim Client As Integer 'décalre la variable Client
HyperLien = "mailto:" & Adresse & "?" ' définit la variable Hyperlien (Le ? introduit les arguments)
HyperLien = HyperLien & "Subject=" & Objet 'redéfinit la variable Hyperlien
HyperLien = HyperLien & "&Body=" & Corps ' le & sépare les arguments
If Cc <> "" Then HyperLien = HyperLien & "&cc=" & Cc 'condition si l'argument CC existe
If Bcc <> "" Then HyperLien = HyperLien & "&bcc=" & Bcc 'condition si l'argument Bcc existe
' Activation du lien
'
ActiveWorkbook.FollowHyperlink HyperLien ' en cliquant sur un lien mailto, ouvre Outlook 2010 avec les argements
Attendre 2 ' Appel d'une procédure qui temporise
'Initialisation des tableaux de touches pour Outlook Express
'Pour une pièce jointe
TouchesPJ(0) = 3 ' Nombre de touches nécessaires
TouchesPJ(1) = "%s" ' Appel du menu Insertion par la touche Alt-s
TouchesPJ(2) = "j" ' appel du sous-menu pièce par la touche j
TouchesPJ(3) = "f" ' puis par la touche f
TouchesEnvoi(0) = 1 ' Nombre de touches nécessaires
TouchesEnvoi(1) = "^~" ' Envoi du message avec Ctl-ENTER
'condition si 'argumet "PJ: exsite
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
For i = 1 To TouchesEnvoi(0)
SendKeys TouchesEnvoi(i), True ' on envoie le message
Next i
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 |
Partager