le 2 non plus, je désespere 
Voilà le code de la fonction du formulaire:
Private Sub envoyer_Click()
If envoyer.Value = True Then
On Error GoTo GestErreur
Call EnvoiEmail(email.Value, "ENVOI DU COLIS", "Bonjour," & Chr(13) & Chr(10) & " votre colis a été préparé. Il sera envoyé lors du prochain enlèvement et expédié à l'adresse suivante: ", [nom et prénom], ADRESSE, [code postal], localité, pays, "Contactez nous au plus vite si une de ces données ne s'avérait pas exacte.", "L'équipe Bc-elec.com" )
Exit Sub
GestErreur: MsgBox ("Envoi de la confirmation impossible ! Vous devez d'abord renseigner l'Email du client !" )
End If
End Sub
Voilà le code de la fonction ENVOIEMAIL:
Option Compare Database
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, Corps2 As String, Corps3 As String, Corps4 As String, Corps5 As String, Corps6 As String, Corps7 As String, Corps8 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 & Corps2 & Corps3 & Corps4 & Corps5 & Corps6 & Corps7 & Corps8
' 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
If Form_ventes1.Option114.Value = True Then ' Mozilla Thunderbird
MozillaThunderbird
Else
If Form_ventes1.Option112.Value = False Then ' Outlook Express
OutLookExpress
Else ' Office 2003 Outlook
If Form_ventes1.optionOffice2003outlook.Value = False Then ' Office2003OutLook
Office2003OutLook
Else ' Aucune coche
MsgBox "Aucun client de messagerie connu n'est indiqué"
Exit Sub
End If
End If
End If
' 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
Message édité par Bennyb666 le 11-10-2005 à 14:22:54
