Envoi d'un mail avec Excel via VBA par Outlook 2003
1 réponse
totom7
Bonjour,
Je vous joint le code :
Proc=E9dure g=E9n=E9ral :
Private Sub Preparation()
Dim NbTaches As Integer, LeMessage As String, LObjet As String
Dim R=E9ponse As Integer
Dim ColA, ColB, ColC, ColD, ColE, ColF As String
Dim Tabule, Saut As String
Dim Cell_I As Integer
Dim Cell_A, Cell_L1, Cell_L2, Cell_L3, Cell_L4, Cell_L5, Cell_L6 As
String
' s=E9lection de la feuille de test
Workbooks(1).Activate
Worksheets("SROS").Select
' positionnement au d=E9but de la liste des taches (la cellule A5
est nomm=E9)
NbTaches =3D 1 ' initialisation du compteur de taches
LeMessage =3D "" ' initialisation du message qui re=E7oit les
taches urgentes
Tabule =3D ""
Saut =3D "%0A"
Cell_L1 =3D "A"
Cell_L2 =3D "B"
Cell_L3 =3D "C"
Cell_L4 =3D "D"
Cell_L5 =3D "E"
Cell_L6 =3D "F"
Cell_I =3D 1
'If NbTaches > 0 Then
'MsgBox avec boutons Oui et Non. La fonction renvoie la
r=E9ponse
' de l'utilisateur
' R=E9ponse =3D MsgBox("Confirmer l'envoi d'un message pour " &
NbTaches & " taches", vbYesNo + vbQuestion, "CONFIRMATION SVP")
' If R=E9ponse =3D vbYes Then
' LObjet =3D "Liste des " & NbTaches & " t=E2ches urgentes =E0
effectuer"
' appel de la proc=E9dure d'envoi du mail
' ici le 4=E8me argument (la pi=E8ce jointe)
' n'est pas renseign=E9
' End If
'End If
End Sub
Module EnvoiEmail :
Sub EnvoiEmail(Adresse As String, Objet As String, Corps As String,
Optional PJ As String)
' Remarque : l'argument PJ (pi=E8ce jointe) est optionnel. S'il est
fourni,
' c'est le chemin complet du fichier =E0 joindre qui doit =EAtre fourni
' pour joindre plusieurs pi=E8ces,
' il faudrait que PJ soit un tableau et qu'il soit trait=E9 + bas par
une boucle...
Dim HyperLien As String ' Re=E7oit les =E9l=E9ments de l'hyperlien
' compos=E9s =E0 partir des arguments fournis =E0
la proc=E9dure
Dim i As Integer ' un compteur
Dim Client As Integer
' la syntaxe de base du mailto est la suivante :
' mailto:dest@domaine.bof?Subject=3DLe sujet du message&Body=3DLe corps du
message
' je ne prends pas en compte les copies, copies cach=E9es ou autres
confirmation de lecture
' il faudrait utiliser d'autre arguments de mailto...
HyperLien =3D "mailto:" & Adresse & "?" ' Le ? introduit les
arguments
HyperLien =3D HyperLien & "Subject=3D" & Objet & " (=E0 " & Time() & ")"
HyperLien =3D HyperLien & "&Body=3D" & Corps ' le & s=E9pare les
arguments
'MsgBox Application.Name
' Activation du lien
'
' Pour Excel (les autres doivent =EAtre en commentaire)
ActiveWorkbook.FollowHyperlink HyperLien
' Pour Word (les autres doivent =EAtre en commentaire)
' ThisDocument.FollowHyperlink HyperLien
' Pour Access (les autres doivent =EAtre en commentaire)
' Application.FollowHyperlink HyperLien
Attendre 1 ' Appel d'une proc=E9dure
qui temporise
' c'est =E0 dire que la
proc=E9dure courante
' (ici EnvoiMail) est
suspendue pendant 5s
' cela permet d'Attendrere
que le client
' de messagerie soit lanc=E9
et pr=EAt
' avant d'envoyer les
touches
' sinon ce serait le
programme appelant
' (ici Excel) qui recevrait
les touches
Select Case Client ' appel du chargement des tableaux des touches
selon le
' client de messagerie indiqu=E9
Case 1
OutLookExpress
Case 2
MozillaThunderbird
Case 3
Office2003OutLook
Case Else
MsgBox "Aucun client de messagerie connu n'est indiqu=E9"
Exit Sub
End Select
' Le traitement de la pi=E8ce jointe ne s'ex=E9cute que si la proc=E9dure
=E0 re=E7u qqchose
' dans l'argument PJ (Optional<=3D>Facultatif)
'If PJ <> "" Then
' For i =3D 1 To TouchesPJ(0) ' dans TouchesPJ(0) on a stock=E9 le
nombre de touches
' =E0 envoyer au programme pour joindre
une pi=E8ce
' SendKeys TouchesPJ(i), True ' Envoie les touches d'ajout
d'1 pi=E8ce jointe
' Attendre 1 ' temporise (=E0 r=E8gler
=E9ventuellement)
' Next i
' SendKeys PJ, True ' A ce stade le programme Attendre 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
i =3D 0
For i =3D 1 To TouchesEnvoi(0)
Attendre 1
SendKeys TouchesEnvoi(i), True ' on envoie le message
Next i
'MsgBox ("C'est finis")
End Sub
Sub Attendre(Secondes As Integer)
' Cette proc=E9dure temporise pendant le nombre de secondes qu'on lui
transmet en argument
Dim D=E9but As Long, Fin As Long, Chrono As Long
D=E9but =3D Timer
Fin =3D D=E9but + Secondes
Do Until Timer >=3D Fin
' DoEvents
Loop
End Sub
Sub OutLookExpress()
'Initialisation des tableaux de touches pour Outlook Express
' Pour une pi=E8ce jointe
TouchesPJ(0) =3D 2 ' Nombre de touches n=E9cessaires
TouchesPJ(1) =3D "%i" ' Appel du menu Insertion par la touche
Alt-i
TouchesPJ(2) =3D "p" ' appel du sous-menu pi=E8ce par la touche p
' Pour l'envoi du mail
TouchesEnvoi(0) =3D 1 ' Nombre de touches n=E9cessaires
TouchesEnvoi(1) =3D "%s" ' Envoi du message avec Alt-s
End Sub
Sub MozillaThunderbird()
'Initialisation des tableaux de touches pour Mozilla Thunderbird
' Pour une pi=E8ce jointe
TouchesPJ(0) =3D 3 ' Nombre de touches n=E9cessaires
TouchesPJ(1) =3D "%f" ' Appel du menu Fichier par la touche Alt-f
TouchesPJ(2) =3D "j" ' appel du sous-menu Joindre par la touche
j
TouchesPJ(3) =3D "f" ' appel du sous-sous-menu Fichier par la
touche f
' Pour l'envoi du mail
TouchesEnvoi(0) =3D 2 ' Nombre de touches n=E9cessaires
TouchesEnvoi(1) =3D "^{ENTER}" ' Envoi du message avec
Ctrl-Entr=E9e
TouchesEnvoi(2) =3D "{ENTER}" ' confirmation par Entr=E9e
End Sub
Sub Office2003OutLook()
'Initialisation des tableaux de touches pour Office Outlook
' Pour une pi=E8ce jointe
TouchesPJ(0) =3D 2 ' Nombre de touches n=E9cessaires
TouchesPJ(1) =3D "%i" ' Appel du menu Insertion par la touche
Alt-i
TouchesPJ(2) =3D "f" ' appel du sous-menu fichier par la touche
f
' Pour l'envoi du mail
TouchesEnvoi(0) =3D 1 ' Nombre de touches n=E9cessaires
TouchesEnvoi(1) =3D "%y" ' Envoi du message avec Alt-v
End Sub
Le probl=E8me de cette proc=E9dure est :
Arriv=E9 =E0 :
For i =3D 1 To TouchesEnvoi(0)
Attendre 1
SendKeys TouchesEnvoi(i), True ' on envoie le message
Next i
La proc=E9dure se bloque et le message ne part pas.
Si quelqu'un a une id=E9e, je suis preneur.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Daniel
Bonjour. Je me sers de la macro suivante (que j'ai recopiée quelque part) pour envoyer des mails avec OutLook 2003. Tâche de l'adapter à ton cas :
Sub EnvoiCourrierOutlook2003() Dim OutApp As Object Dim OutMail As Object Dim Message As String Dim objOutlookAttach
Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(olMailItem) Message = "Hi there" & vbNewLine & vbNewLine & _ "This is line 1" & vbNewLine & _ "This is line 2" & vbNewLine & _ "This is line 3" & vbNewLine & _ "This is line 4"
With OutMail .To = "" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = Message Set objOutlookAttach = .Attachments.Add("c:tempbd.xls") .Send 'ou .Display End With
Set OutMail = Nothing Set OutApp = Nothing End Sub
Cordialement. Daniel a écrit dans le message de news:
Bonjour,
Je vous joint le code : Procédure général :
Private Sub Preparation()
Dim NbTaches As Integer, LeMessage As String, LObjet As String Dim Réponse As Integer Dim ColA, ColB, ColC, ColD, ColE, ColF As String Dim Tabule, Saut As String Dim Cell_I As Integer Dim Cell_A, Cell_L1, Cell_L2, Cell_L3, Cell_L4, Cell_L5, Cell_L6 As String
' sélection de la feuille de test Workbooks(1).Activate Worksheets("SROS").Select
' positionnement au début de la liste des taches (la cellule A5 est nommé)
NbTaches = 1 ' initialisation du compteur de taches LeMessage = "" ' initialisation du message qui reçoit les taches urgentes Tabule = "" Saut = "%0A" Cell_L1 = "A" Cell_L2 = "B" Cell_L3 = "C" Cell_L4 = "D" Cell_L5 = "E" Cell_L6 = "F" Cell_I = 1
'If NbTaches > 0 Then 'MsgBox avec boutons Oui et Non. La fonction renvoie la réponse ' de l'utilisateur ' Réponse = MsgBox("Confirmer l'envoi d'un message pour " & NbTaches & " taches", vbYesNo + vbQuestion, "CONFIRMATION SVP") ' If Réponse = vbYes Then ' LObjet = "Liste des " & NbTaches & " tâches urgentes à effectuer" ' appel de la procédure d'envoi du mail ' ici le 4ème argument (la pièce jointe) ' n'est pas renseigné
' End If 'End If End Sub
Module EnvoiEmail :
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 à 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:?Subject=Le sujet du message&Body=Le corps du message ' je ne prends pas en compte les copies, copies cachées ou autres confirmation de lecture ' 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 'MsgBox Application.Name
' 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 1 ' Appel d'une procédure qui temporise ' c'est à dire que la procédure courante ' (ici EnvoiMail) est suspendue pendant 5s ' cela permet d'Attendrere 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
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 ' 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 Attendre 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 i = 0 For i = 1 To TouchesEnvoi(0) Attendre 1 SendKeys TouchesEnvoi(i), True ' on envoie le message Next i 'MsgBox ("C'est finis") 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" ' appel du 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) = "%y" ' Envoi du message avec Alt-v End Sub
Le problème de cette procédure est : Arrivé à :
For i = 1 To TouchesEnvoi(0) Attendre 1 SendKeys TouchesEnvoi(i), True ' on envoie le message Next i
La procédure se bloque et le message ne part pas. Si quelqu'un a une idée, je suis preneur.
Bonjour.
Je me sers de la macro suivante (que j'ai recopiée quelque part) pour
envoyer des mails avec OutLook 2003. Tâche de l'adapter à ton cas :
Sub EnvoiCourrierOutlook2003()
Dim OutApp As Object
Dim OutMail As Object
Dim Message As String
Dim objOutlookAttach
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
Message = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
With OutMail
.To = "dcolardelleZZZZ@free.fr"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = Message
Set objOutlookAttach = .Attachments.Add("c:tempbd.xls")
.Send 'ou .Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Cordialement.
Daniel
<totom7@gmail.com> a écrit dans le message de news:
1149857080.523829.177150@f6g2000cwb.googlegroups.com...
Bonjour,
Je vous joint le code :
Procédure général :
Private Sub Preparation()
Dim NbTaches As Integer, LeMessage As String, LObjet As String
Dim Réponse As Integer
Dim ColA, ColB, ColC, ColD, ColE, ColF As String
Dim Tabule, Saut As String
Dim Cell_I As Integer
Dim Cell_A, Cell_L1, Cell_L2, Cell_L3, Cell_L4, Cell_L5, Cell_L6 As
String
' sélection de la feuille de test
Workbooks(1).Activate
Worksheets("SROS").Select
' positionnement au début de la liste des taches (la cellule A5
est nommé)
NbTaches = 1 ' initialisation du compteur de taches
LeMessage = "" ' initialisation du message qui reçoit les
taches urgentes
Tabule = ""
Saut = "%0A"
Cell_L1 = "A"
Cell_L2 = "B"
Cell_L3 = "C"
Cell_L4 = "D"
Cell_L5 = "E"
Cell_L6 = "F"
Cell_I = 1
'If NbTaches > 0 Then
'MsgBox avec boutons Oui et Non. La fonction renvoie la
réponse
' de l'utilisateur
' Réponse = MsgBox("Confirmer l'envoi d'un message pour " &
NbTaches & " taches", vbYesNo + vbQuestion, "CONFIRMATION SVP")
' If Réponse = vbYes Then
' LObjet = "Liste des " & NbTaches & " tâches urgentes à
effectuer"
' appel de la procédure d'envoi du mail
' ici le 4ème argument (la pièce jointe)
' n'est pas renseigné
' End If
'End If
End Sub
Module EnvoiEmail :
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 à 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
' je ne prends pas en compte les copies, copies cachées ou autres
confirmation de lecture
' 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
'MsgBox Application.Name
' 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 1 ' Appel d'une procédure
qui temporise
' c'est à dire que la
procédure courante
' (ici EnvoiMail) est
suspendue pendant 5s
' cela permet d'Attendrere
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
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
' 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 Attendre 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
i = 0
For i = 1 To TouchesEnvoi(0)
Attendre 1
SendKeys TouchesEnvoi(i), True ' on envoie le message
Next i
'MsgBox ("C'est finis")
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" ' appel du 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) = "%y" ' Envoi du message avec Alt-v
End Sub
Le problème de cette procédure est :
Arrivé à :
For i = 1 To TouchesEnvoi(0)
Attendre 1
SendKeys TouchesEnvoi(i), True ' on envoie le message
Next i
La procédure se bloque et le message ne part pas.
Si quelqu'un a une idée, je suis preneur.
Bonjour. Je me sers de la macro suivante (que j'ai recopiée quelque part) pour envoyer des mails avec OutLook 2003. Tâche de l'adapter à ton cas :
Sub EnvoiCourrierOutlook2003() Dim OutApp As Object Dim OutMail As Object Dim Message As String Dim objOutlookAttach
Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(olMailItem) Message = "Hi there" & vbNewLine & vbNewLine & _ "This is line 1" & vbNewLine & _ "This is line 2" & vbNewLine & _ "This is line 3" & vbNewLine & _ "This is line 4"
With OutMail .To = "" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = Message Set objOutlookAttach = .Attachments.Add("c:tempbd.xls") .Send 'ou .Display End With
Set OutMail = Nothing Set OutApp = Nothing End Sub
Cordialement. Daniel a écrit dans le message de news:
Bonjour,
Je vous joint le code : Procédure général :
Private Sub Preparation()
Dim NbTaches As Integer, LeMessage As String, LObjet As String Dim Réponse As Integer Dim ColA, ColB, ColC, ColD, ColE, ColF As String Dim Tabule, Saut As String Dim Cell_I As Integer Dim Cell_A, Cell_L1, Cell_L2, Cell_L3, Cell_L4, Cell_L5, Cell_L6 As String
' sélection de la feuille de test Workbooks(1).Activate Worksheets("SROS").Select
' positionnement au début de la liste des taches (la cellule A5 est nommé)
NbTaches = 1 ' initialisation du compteur de taches LeMessage = "" ' initialisation du message qui reçoit les taches urgentes Tabule = "" Saut = "%0A" Cell_L1 = "A" Cell_L2 = "B" Cell_L3 = "C" Cell_L4 = "D" Cell_L5 = "E" Cell_L6 = "F" Cell_I = 1
'If NbTaches > 0 Then 'MsgBox avec boutons Oui et Non. La fonction renvoie la réponse ' de l'utilisateur ' Réponse = MsgBox("Confirmer l'envoi d'un message pour " & NbTaches & " taches", vbYesNo + vbQuestion, "CONFIRMATION SVP") ' If Réponse = vbYes Then ' LObjet = "Liste des " & NbTaches & " tâches urgentes à effectuer" ' appel de la procédure d'envoi du mail ' ici le 4ème argument (la pièce jointe) ' n'est pas renseigné
' End If 'End If End Sub
Module EnvoiEmail :
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 à 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:?Subject=Le sujet du message&Body=Le corps du message ' je ne prends pas en compte les copies, copies cachées ou autres confirmation de lecture ' 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 'MsgBox Application.Name
' 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 1 ' Appel d'une procédure qui temporise ' c'est à dire que la procédure courante ' (ici EnvoiMail) est suspendue pendant 5s ' cela permet d'Attendrere 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
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 ' 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 Attendre 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 i = 0 For i = 1 To TouchesEnvoi(0) Attendre 1 SendKeys TouchesEnvoi(i), True ' on envoie le message Next i 'MsgBox ("C'est finis") 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" ' appel du 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) = "%y" ' Envoi du message avec Alt-v End Sub
Le problème de cette procédure est : Arrivé à :
For i = 1 To TouchesEnvoi(0) Attendre 1 SendKeys TouchesEnvoi(i), True ' on envoie le message Next i
La procédure se bloque et le message ne part pas. Si quelqu'un a une idée, je suis preneur.
