VBA: ouverture d outlook pour envoie d email.

B

beniboy

XLDnaute Nouveau
Bonjour,

j'ai créé une macro sur excel qui me permet d envoyer des emails via outlook. Le probleme est que cela requiert que OUTLOOK soit ouvert. S il ne l'est pas, rien ne se passe (meme pas sauvegardé jusqu a ouverture pour envoie).

J'ai vu également la méthode d'envoie d email directement par le serveur mais cela ne me convient pas car je perds trace de ce qui a été envoyé.

est t il possible de lancer l ouverture d outlook afin que les messages soient envoyés sans avoir à l ouvrir manuellement ?

voici mon code existant.

merci pour le coup de main

Code: 
' obligatoire pour récuperer la signature outlook dans l'email

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

' procedure pour envoyer le mail

Public Sub EnvoiAutomatiqueMail()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim EMail As String
Dim strbody As String
Dim SigString As String
Dim Signature As String

y = Range("h" & Rows.Count).End(xlUp).Row
For i = 2 To y
    genre = Range("a" & i)
    nom = Range("b" & i)
    restaurant = Range("d" & i)
    heure = Range("e" & i)
    jour = Range("f" & i)
    couverts = Range("g" & i)
    EMail = Range("h" & i)
    
' definition du corps du mail "strbody" (sans la signature outlook)


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


        strbody = genre & " " & nom & ",<BR><BR>" & _
             "comme indiqué par téléphone, je vous confirme votre réservation au restaurant " & _
             "<B>" & restaurant & "</B>" & " le " & "<B>" & Format(jour, "dddd dd MMMM YYYY") & "</B>" & _
             " à " & "<B>" & Format(heure, "HH:MM") & "</B>" & " pour " & "<B>" & couverts & " personnes." & "</B><BR><BR>" & _
              "Cordialement,<BR><BR>Le service réservation"

' recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"

SigString = Environ("appdata") & _
     "\Microsoft\Signatures\mysign.htm"
     
    If Dir(SigString) <> "" Then
            Signature = GetBoiler(SigString)
        Else
            Signature = ""
    End If
    
On Error Resume Next
    OutlookMail.Open
    With OutlookMail
        .Subject = "Réservation: " & Format(jour, "dddd dd/mm/yy") & " à " & _
             Format(heure, "hh:mm") & " - " & couverts & " pers. " & " restaurant " & restaurant & "
        .To = EMail
        .HTMLBody = strbody & "<br><br>" & Signature
    

OutlookMail.Send

End With

'recommence la procedure pour la réservation suivante

Next i

End Sub
 
Trier par date Trier par votes
Y

Yaloo

XLDnaute Barbatruc
Re : VBA: ouverture d outlook pour envoie d email.

Bonsoir beniboy, le forum,

Juste après tes déclarations de variables, tu mets :

VB: 
    Dim i
    If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)

Puis, tu copies cette fonction dans ton module :

VB: 
Function OutlookOuvert() As Boolean
  Dim oOL As Object
  On Error Resume Next
  Set oOL = GetObject(, "Outlook.Application")
  On Error GoTo 0
  OutlookOuvert = Not (oOL Is Nothing)
  Set oOL = Nothing
End Function

Si Outlook n'est pas déjà ouvert, alors ça ouvre Outlook sinon ta macro se déroule normalement.

A te relire

Martial
 
Vote positif 0 Vote négatif
B

beniboy

XLDnaute Nouveau
Re : VBA: ouverture d outlook pour envoie d email.

Bonjour,

merci !!
cependant je n arrive pas à le faire marcher. ci dessous ce que j'ai ajouté comme tu me l as indiqué mais il me dit qu 'il manque un "end sub".
je dois faire une erreur qq part mais aucune idée ou !!

merci pour le coup d'oeil !!

a+


Code: 
' obligatoire pour récuperer la signature outlook dans l'email

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

' procedure pour envoyer le mail

Public Sub EnvoiAutomatiqueMail()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim EMail As String
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim i
    If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)

y = Range("h" & Rows.Count).End(xlUp).Row
For i = 2 To y
    genre = Range("a" & i)
    nom = Range("b" & i)
    restaurant = Range("d" & i)
    heure = Range("e" & i)
    jour = Range("f" & i)
    couverts = Range("g" & i)
    EMail = Range("h" & i)
    
' definition du corps du mail "strbody" (sans la signature outlook)


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

Function OutlookOuvert() As Boolean
  Dim oOL As Object
  On Error Resume Next
  Set oOL = GetObject(, "Outlook.Application")
  On Error GoTo 0
  OutlookOuvert = Not (oOL Is Nothing)
  Set oOL = Nothing
End Function


        strbody = genre & " " & nom & ",<BR><BR>" & _
             "comme indiqué par téléphone, je vous confirme votre réservation au restaurant " & _
             "<B>" & restaurant & "</B>" & " le " & "<B>" & Format(jour, "dddd dd MMMM YYYY") & "</B>" & _
             " à " & "<B>" & Format(heure, "HH:MM") & "</B>" & " pour " & "<B>" & couverts & " personnes." & "</B><BR><BR>" & _
              "Cordialement,<BR><BR>Le service réservation"

' recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"

SigString = Environ("appdata") & _
     "\Microsoft\Signatures\mysign.htm"
     
    If Dir(SigString) <> "" Then
            Signature = GetBoiler(SigString)
        Else
            Signature = ""
    End If
    
On Error Resume Next
    OutlookMail.Open
    With OutlookMail
        .Subject = "Réservation: " & Format(jour, "dddd dd/mm/yy") & " à " & _
             Format(heure, "hh:mm") & " - " & couverts & " pers. " & " restaurant " & restaurant & "
        .To = EMail
        .HTMLBody = strbody & "<br><br>" & Signature
    

OutlookMail.Send

End With

'recommence la procedure pour la réservation suivante

Next i

End Sub
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : VBA: ouverture d outlook pour envoie d email.

Bonjour beniboy, le forum,

Il faut copier la fonction en dehors de ta macro. je te mets l'ensemble pour remplacer ce que tu as déjà.

VB: 
Function GetBoiler(ByVal sFile As String) As String
 'Dick Kusleika
     Dim fso As Object
     Dim ts As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
     GetBoiler = ts.readall
     ts.Close
 End Function

 ' procedure pour envoyer le mail

 Public Sub EnvoiAutomatiqueMail()
 Dim OutlookApp As Object
 Dim OutlookMail As Object
 Dim EMail As String
 Dim strbody As String
 Dim SigString As String
 Dim Signature As String
 Dim i
     If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)

 y = Range("h" & Rows.Count).End(xlUp).Row
 For i = 2 To y
     genre = Range("a" & i)
     nom = Range("b" & i)
     restaurant = Range("d" & i)
     heure = Range("e" & i)
     jour = Range("f" & i)
     couverts = Range("g" & i)
     EMail = Range("h" & i)
     
 ' definition du corps du mail "strbody" (sans la signature outlook)


 Set OutlookApp = CreateObject("Outlook.Application")
 Set OutlookMail = OutlookApp.CreateItem(0)



         strbody = genre & " " & nom & ",<BR><BR>" & _
              "comme indiqué par téléphone, je vous confirme votre réservation au restaurant " & _
              "<B>" & restaurant & "</B>" & " le " & "<B>" & Format(jour, "dddd dd MMMM YYYY") & "</B>" & _
              " à " & "<B>" & Format(heure, "HH:MM") & "</B>" & " pour " & "<B>" & couverts & " personnes." & "</B><BR><BR>" & _
               "Cordialement,<BR><BR>Le service réservation"

 ' recupere la signature outlook, definis à qui envoyer, l'objet et ajoute la signature outlook au corps du mail "strbody"

 SigString = Environ("appdata") & _
      "\Microsoft\Signatures\mysign.htm"
      
     If Dir(SigString) <> "" Then
             Signature = GetBoiler(SigString)
         Else
             Signature = ""
     End If
     
 On Error Resume Next
     OutlookMail.Open
     With OutlookMail
         .Subject = "Réservation: " & Format(jour, "dddd dd/mm/yy") & " à " & _
              Format(heure, "hh:mm") & " - " & couverts & " pers. " & " restaurant " & restaurant & ""
         .To = EMail
         .HTMLBody = strbody & "<br><br>" & Signature
     

 OutlookMail.Send

 End With

 'recommence la procedure pour la réservation suivante

 Next i

 End Sub

 Function OutlookOuvert() As Boolean
   Dim oOL As Object
   On Error Resume Next
   Set oOL = GetObject(, "Outlook.Application")
   On Error GoTo 0
   OutlookOuvert = Not (oOL Is Nothing)
   Set oOL = Nothing
 End Function

A te relire

Martial
 
Vote positif 0 Vote négatif
B

beniboy

XLDnaute Nouveau
Re : VBA: ouverture d outlook pour envoie d email.

Bonjour Yaloo,

je n'arrive pas à faire marcher ce que tu m as donné.
J'ai intégré le code mais maintenant, outlook s ouvre si il est fermé. Si il est déjà ouvert il ne se passe rien (meme pas l'écriture du mail).

Je ne suis pas sûr de bien comprendre où je dois copier la fonction. Est ce dans un nouveau module ? ou un module de classe ?

mon but est de pouvoir envoyer un email a chaque personne sur mon fichier excel juste par un bouton. En appuyant sur le bouton:
  • outlook doit s ouvrir s il n'est pas déjà ouvert
  • créer un nouveau message
  • copier l adresse du 1er destinataire
  • copier le sujet
  • copier le texte
  • ajouter la signature outlook
  • envoyer le message
  • puis recommencer la meme procedure avec le 2éme destinataire, etc.

à ce jour, je ne maitrise pas l ouverture d outlook, le reste marche si outlook est ouvert.

merci encore pour tes réponses.

au plaisir de te relire très vite ;)
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : VBA: ouverture d outlook pour envoie d email.

Re,

Je te joins un fichier, chez moi (Office 2010) ça fonctionne avec Outlook fermé ou ouvert.

A te relire

Martial
 

Pièces jointes

  • Envoi mail.xls
    50.5 KB · Affichages: 349
  • Envoi mail.xls
    50.5 KB · Affichages: 334
  • Envoi mail.xls
    50.5 KB · Affichages: 353
Vote positif 0 Vote négatif
N

nicopof

XLDnaute Nouveau
Re : VBA: ouverture d outlook pour envoie d email.

Bonjour,

La discutions est très intéressante pour moi, je cherche la même chose; j'ai actuellement une macro qui m'envoie des mail auto en fonction d'un nombre qui est placer dans une cellule, mais si Outlook n'est pas lancer, le mail ne part pas. J'ai essayer d’intégrer ta formule dans ma macro, mais sa met une erreur. voici ma macro.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub
Dim tablCode
tablCode = Array(31, 34, 36, 18, 99)

If Target.Column = 21 Or Target.Column = 25 Or Target.Column = 29 Or Target.Column = 33 Then
For i = 0 To 4
If Target.Value = tablCode(i) Then
'Macro email
'--------------------------------------------------------
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = " DL " & tablCode(i)
Email_Send_From = "xxxxxx@gmail.com"
Email_Send_To = "xxxxxx@gmail.com"
Email_Cc = "xxxxxx@gmail.com"
Email_Bcc = "xxxxxx@gmail.com"
Email_Body = "Auto-mail" & vbCr & _
"" & vbCr & _
"Un code " & tablCode(i) & " a été attribué à un vol aujourd'hui" & vbCr & _
vbCr & _
"Date : " & Cells(Target.Row, 1) & vbCr & _
"Nom agent: " & Cells(Target.Row, 2) & vbCr & _
"Vol Départ: " & Cells(Target.Row, 13) & vbCr & _
"STD: " & Format(Cells(Target.Row, 18), "hh:mm") & vbCr & _
"ATD: " & Format(Cells(Target.Row, 19), "hh:mm") & vbCr & vbCr & _
"DR1: " & Cells(Target.Row, 21) & vbCr & _
"Time: " & Format(Cells(Target.Row, 22), "hh:mm") & vbCr & _
"Explication: " & Format(Cells(Target.Row, 23), "hh:mm") & vbCr & vbCr & _
"DR2: " & Cells(Target.Row, 24) & vbCr & _
"Time: " & Format(Cells(Target.Row, 25), "hh:mm") & vbCr & _
"Explication: " & Format(Cells(Target.Row, 26), "hh:mm") & vbCr & vbCr & _
"DR3: " & Cells(Target.Row, 27) & vbCr & _
"Time: " & Format(Cells(Target.Row, 28), "hh:mm") & vbCr & _
"Explication: " & Format(Cells(Target.Row, 29), "hh:mm") & vbCr & vbCr & _
"DR4: " & Cells(Target.Row, 30) & vbCr & _
"Time: " & Format(Cells(Target.Row, 31), "hh:mm") & vbCr & _
"Explication: " & Format(Cells(Target.Row, 32), "hh:mm") & vbCr & vbCr & _
"@TT"

On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.Send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
'----------------------------------------------------------------
End If

Next
End If
End Sub


Ma macro est placer directement dans la feuille et pas dans le module ou "thisworkbook". Comme Yaloo j'aimerai lancer Outlook si il n'est pas ouvert afin d'envoyer le mail auto.

Merci d'avance
 
Vote positif 0 Vote négatif
Y

Yaloo

XLDnaute Barbatruc
Re : VBA: ouverture d outlook pour envoie d email.

Bonjour nicopof , le forum,

Tu rajoutes, en début de macro, la ligne suivante :
If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)
Cliquez pour agrandir...

Puis tu copies la fonction ci-dessous dans un module standard :
VB: 
Function OutlookOuvert() As Boolean
  Dim oOL As Object
  On Error Resume Next
  Set oOL = GetObject(, "Outlook.Application")
  On Error GoTo 0
  OutlookOuvert = Not (oOL Is Nothing)
  Set oOL = Nothing
End Function

A+

Martial
 
Vote positif 0 Vote négatif
N

nicopof

XLDnaute Nouveau
Re : VBA: ouverture d outlook pour envoie d email.

Excellent sa fonction merci , j'ai juste remplacée false then i par false then o car j'avais déjà a i dans la macro du coup sa faisais un bug.

Tu m'a l'air bien caler en macro ,je cherche a améliorer mon email body,actuellement le mail par automatiquement quand dans la colonne 21 par exemple il y a un code 31 ou 99 ou... L'agent marque des compléments d'infos dans la colonne 22 23 et 24 (quand le code est mit dans la colonne 21), bref sur le même ligne les colonne suivant a chaque fois.
J'avais penser a mettre une tempo, le mail partirai une minute après, mais dans les forum on me dis que c'est trop compliqué a faire. Aurait-tu une idée?
Merci quand meme
 
Vote positif 0 Vote négatif
gosselien

gosselien

XLDnaute Barbatruc
Re : VBA: ouverture d outlook pour envoie d email.

Bonjour,

un décompte ou rebours peut être comme ceci:

a = Timer
newHeure = Hour(Now())
newMinute = Minute(Now())
newSeconde = Second(Now()) + 2
waitTime = TimeSerial(newHeure, newMinute, newSeconde)
Application.Wait waitTime
b = Timer
MsgBox (b - a) ' send mail ici
 
Vote positif 0 Vote négatif
N

nicopof

XLDnaute Nouveau
Re : VBA: ouverture d outlook pour envoie d email.

Bonjour,
Alors j'avais déjà essayer "l'application.wait" Le problème c'est qu'il attend bien le nombre de seconde demandé mais tu ne peux plus rien faire pendant ce temps la.
J'ai essayer celle ci aussi sauf que j'arrive pas a l'appliquer ou alors je le lace mal dans ma macro je sais pas
Application.OnTime Now + TimeValue("00:00:30"), "my_Procedure"

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim tablCode
tablCode = Array(31, 34, 36, 18, 99)

If Target.Column = 21 Or Target.Column = 24 Or Target.Column = 27 Or Target.Column = 30 Then
For i = 0 To 4
If Target.Value = tablCode(i) Then
Application.OnTime Now + TimeValue("00:00:30"), "Worksheet_Change"
'Macro email
'--------------------------------------------------------

If OutlookOuvert = False Then o = Shell("Outlook", vbNormalNoFocus)
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = " DL " & tablCode(i)
Email_Send_From = "prukop.nico@gmail.com"
Email_Send_To = "prukop.nico@gmail.com"
......................
 
Vote positif 0 Vote négatif

Discussions similaires

N
  • Résolu(e)
XL 2021 Exporter un graphique dans Outlook
Réponses
3
Affichages
184
NLSCt
N
R3n0W
  • Résolu(e)
XL 2016 If Not xRgSel Is Nothing Then --> Ne marche pas
Réponses
10
Affichages
166
R3n0W
R3n0W
K
  • Résolu(e)
XL 2019 Probleme codage
Réponses
2
Affichages
234
Kevin42560
K
V
  • Résolu(e)
Microsoft 365 Envoie mail automatique
2
Réponses
17
Affichages
1 K
vby
V
My<3
  • Question
XL 2019 HTML Corps de mail
Réponses
6
Affichages
306
My<3
My<3
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
240
halecs93
halecs93
F
  • Résolu(e)
XL 2019 Enregistrer sous la feuille active dans répertoire du fichier père en vba
2
Réponses
23
Affichages
685
Fabrice16ct
F
J
  • Résolu(e)
XL 2013 Macro et script vba : macro s'arrête dès la première condition trouvée
Réponses
11
Affichages
432
Janu44
J
O
  • Question
Microsoft 365 Excel [VBA]. Erreur d’exécution 424 Objet requis sur une concaténation
Réponses
3
Affichages
155
Oneida
Oneida
A
  • Question
Microsoft 365 Code VBA Envoi contenu tableau Excel par Email
Réponses
1
Affichages
121
Phil69970
Phil69970

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 21 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote