Code vba outlook Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
M
MANGO19
Membre habitué
Membre habitué
Messages : 117
Inscrit le : 6 janvier 2019
Version d'Excel : 2007

Message par MANGO19 » 1 novembre 2019, 08:36

Bonjour,
je poste ci-dessous un code VBA outlook mais il fonctionne pas :oops: SOS
Sub CustomMsgBox(msg)
  Set Outlook = CreateObject("Outlook.Application")
  Outlook.Navigate "about:blank"

 ' While Outlook.ReadyState <> 4: WScript.Sleep 100: Wend

  ol.Toolbar = False
  ol.StatusBar = False
  ol.Width = 600
  ol.Height = 420

  ol.document.body.innerOutlook = "<p class='msg'>" & msg & "</p>" & _
    "<p class='ctrl'><input type='hidden' id='OK' name='OK' value='0'>" & _
    "<input type='submit' value='OK' id='OKButton' " & _
    "onclick='document.all.OK.value=1'></p>"
    
    Set Style = ie.document.CreateStyleSheet
  Style.AddRule "p.msg", "font-weight:bold;"
  Style.AddRule "p.ctrl", "text-align:rightf;"

  Outlook.Visible = True
  On Error Resume Next
  Do While ie.document.all.OK.Value = 0
    WScript.Sleep 200
  Loop
  Outlook.Quit
End Sub

Private Const COLOR_WINDOWTEXT As Long = 8
Private Const CHANGE_INDEX As Long = 1
Merci par avance
Amicalement
Mango19
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 1 novembre 2019, 11:47

Bonjour,

Donc, tu es sur deux forums avec des pseudos différents, lilifer19 et ici Mango19 !
Je t'ai répondu sur l'autre forum te disant que ce que tu cherche à faire ne peut pas fonctionner puisque tu confonds Outlook et Internet Explorer.
Je t'avais donné un code pour Outlook qui chez moi fonctionne très bien donc, je ne vois pas trop ce que tu cherches à faire ?
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
M
MANGO19
Membre habitué
Membre habitué
Messages : 117
Inscrit le : 6 janvier 2019
Version d'Excel : 2007

Message par MANGO19 » 1 novembre 2019, 13:49

Bonjour Theze,

Celui qui dit "moi je sais! " est plus ignorant que l'ignorant ; il faut toujours savoir apprendre des autres. Ostad Elahi
Ce proverbe pour expliquer mon inscription sur plusieurs forums.

Effectivement, le tableau que vous m'avez envoyé marche très bien mais j'ai voulu l'améliorer en rajoutant des couleurs par péremption et en modifiant le message du mail via outlook, à savoir je voulais une distinction des péremptions ceux à 1 mois ensemble (couleur rouge), à 2 mois (orange) et 3 mois (vert).
Mais étant novice le résultat est catastrophique. je remets le tableau si vous voulez bien y jeter un œil.
Merci pour votre aide
Mango19
TEST225 PROCEDURE ALERTE (6) (2).xlsm
(24.59 Kio) Téléchargé 6 fois
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 1 novembre 2019, 19:39

Dans ce cas là, il te faut construire le message de façon complètement différente puisque tu veux du HTML et ensuite, il faut indiquer à Outlook que tu veux écrire en HTML avec la propriété "HTMLBody" !
Tu ne peux pas utiliser le vbCrLf pour aller à la ligne. Voici une piste mais pour que tu ais un résultat, il faut que dans ton tableau il y ait des dates qui génèrent des valeurs compatibles avec tes tests :
Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim DateLimite As Date
    Dim Texte As String
    Dim Texte1 As String
    Dim Texte2 As String
    Dim Texte3 As String

    With Worksheets("MED PB")

        Set Plage = .Range(.Cells(3, 5), .Cells(.Rows.Count, 5).End(xlUp))
        DateLimite = .Cells(1, 5).Value

    End With

    'boucle et construit le texte pour les produits périmés en HTML
    For Each Cel In Plage

        If Int(DateLimite + 30 - Cel.Value) >= 0 Then
        
             Texte1 = Texte1 & "<b>" & "-" & Cel.Offset(, -4).Value & " " & Cel.Offset(, -3).Value & " " & Cel.Value & "</b><br>"
             
        ElseIf Int(DateLimite + 60 - Cel.Value) >= 0 Then
        
             Texte2 = Texte2 & "<b>" & "-" & Cel.Offset(, -4).Value & " " & Cel.Offset(, -3).Value & " " & Cel.Value & "</b><br>"
            
        ElseIf Int(DateLimite + 90 - Cel.Value) >= 0 Then
        
             Texte3 = Texte3 & "<b>" & "-" & Cel.Offset(, -4).Value & " " & Cel.Offset(, -3).Value & " " & Cel.Value & "</b><br>"
            
        End If

    Next Cel

    'si le texte est vide, pas de produit périmés, fin de procédure
    If Texte1 = "" And Texte2 = "" And Texte3 = "" Then Exit Sub
    
    'début de construction du texte en HTML
    Texte = "<html><body><p>Bonjour,</p>"
    Texte = Texte & IIf(Texte1 <> "", "<p>Les éléments suivants seront périmés dans moins de 30 jours :<br><font color=Red>" & Texte1 & "</font><br></p>", "")
    Texte = Texte & IIf(Texte2 <> "", "<p>Les éléments suivants seront périmés dans moins de 60 jours :<br><font color=orange>" & Texte2 & "</font><br></p>", "")
    Texte = Texte & IIf(Texte3 <> "", "<p>Les éléments suivants seront périmés dans moins de 90 jours :<br><font color=green>" & Texte3 & "</font><br></p>", "")
    Texte = Texte & "<p>Très cordialement.</p><p>Mango</p></body></html>"
        
    EnvoiMail Texte

End Sub


Sub EnvoiMail(Texte As String)
        
    Dim AppOutlook As Object
    Dim OutMail As Object
    
    Set AppOutlook = CreateObject("Outlook.Application")
    Set OutMail = AppOutlook.CreateItem(0)
    
    With OutMail
        
        'adresses des deux personnes à adapter !
        .To = "adressepersonne_1@orange.fr" & ";" & "adressepersonne_2@orange.fr"
        
        .Subject = "Médicaments périmés. Société MANGO ;-)"
                
        .HTMLBody = Texte 'il te faut indiquer à Outlook que tu veux du HTML !
                    
        'affiche le message
        .Display
        
        '.Send '<--- enlever l'apostrophe pour que le mail soit envoyé automatiquement !
        
    End With
    
    Set OutMail = Nothing
    Set AppOutlook = Nothing

End Sub
Pour mieux comprendre, fais quelques recherches sur le net à propos du HTML, il te faut faire attention car bon nombre de balises demande une balise d'ouverture et une balise de fermeture !
Bon courage :wink:
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 2 novembre 2019, 07:42

Bonjour,

Afin que tu puisses faire des essais sur le texte en .html et/ou sur les dates sans pour autant lancer Outlook, je t'ai fais un code qui ouvre le fichier .html dans le navigateur par défaut :
Declare Function ShellExecute _
        Lib "shell32.dll" _
        Alias "ShellExecuteA" ( _
        ByVal hWnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim DateLimite As Date
    Dim Texte As String
    Dim Texte1 As String
    Dim Texte2 As String
    Dim Texte3 As String

    With Worksheets("MED PB")

        Set Plage = .Range(.Cells(3, 5), .Cells(.Rows.Count, 5).End(xlUp))
        DateLimite = .Cells(1, 5).Value

    End With

    'boucle et construit le texte pour les produits périmés en HTML
    For Each Cel In Plage

        If Int(DateLimite + 30 - Cel.Value) >= 0 Then
        
             Texte1 = Texte1 & "<b>" & "-" & Cel.Offset(, -4).Value & " " & Cel.Offset(, -3).Value & " " & Cel.Value & "</b><br>"
             
        ElseIf Int(DateLimite + 60 - Cel.Value) >= 0 Then
        
             Texte2 = Texte2 & "<b>" & "-" & Cel.Offset(, -4).Value & " " & Cel.Offset(, -3).Value & " " & Cel.Value & "</b><br>"
            
        ElseIf Int(DateLimite + 90 - Cel.Value) >= 0 Then
        
             Texte3 = Texte3 & "<b>" & "-" & Cel.Offset(, -4).Value & " " & Cel.Offset(, -3).Value & " " & Cel.Value & "</b><br>"
            
        End If

    Next Cel

    'si le texte est vide, pas de produit périmés, fin de procédure
    If Texte1 = "" And Texte2 = "" And Texte3 = "" Then Exit Sub
    
    'début de construction du texte en HTML
    Texte = "<html><body><p>Bonjour,</p>"
    Texte = Texte & IIf(Texte1 <> "", "<p>Les éléments suivants seront périmés dans moins de 30 jours :<br><font color=Red>" & Texte1 & "</font><br></p>", "")
    Texte = Texte & IIf(Texte2 <> "", "<p>Les éléments suivants seront périmés dans moins de 60 jours :<br><font color=orange>" & Texte2 & "</font><br></p>", "")
    Texte = Texte & IIf(Texte3 <> "", "<p>Les éléments suivants seront périmés dans moins de 90 jours :<br><font color=green>" & Texte3 & "</font><br></p>", "")
    Texte = Texte & "<p>Très cordialement.</p><p>Mango</p></body></html>"
    
    'affichage dans le navigateur par défaut
    Navigateur Texte
    
    'envoi du mail avec Outlook
    'EnvoiMail Texte

End Sub

Sub Navigateur(Texte As String)
    
    Dim Fichier As String
    
    'le fichier texte (qui est un .txt mais enregistré avec l'extansion .html) est enregistré dans le même dossier que le classeur
    Fichier = ThisWorkbook.Path & "\Test pour Outlook.html"
    
    Open Fichier For Output As #1: Print #1, Texte: Close #1
    
    'lance le navigateur par défaut
    ShellExecute 0, "Open", Fichier, "", vbNullString, 1

End Sub

Sub EnvoiMail(Texte As String)
        
    Dim AppOutlook As Object
    Dim OutMail As Object
    
    Set AppOutlook = CreateObject("Outlook.Application")
    Set OutMail = AppOutlook.CreateItem(0)
    
    With OutMail
        
        'adresses des deux personnes à adapter !
        .To = "adressepersonne_1@orange.fr" & ";" & "adressepersonne_2@orange.fr"
        
        .Subject = "Médicaments périmés. Société MANGO ;-)"
                
        .HTMLBody = Texte 'il te faut indiquer à Outlook que tu veux du HTML !
                    
        'affiche le message
        .Display
        
        '.Send '<--- enlever l'apostrophe pour que le mail soit envoyé automatiquement !
        
    End With
    
    Set OutMail = Nothing
    Set AppOutlook = Nothing

End Sub
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
M
MANGO19
Membre habitué
Membre habitué
Messages : 117
Inscrit le : 6 janvier 2019
Version d'Excel : 2007

Message par MANGO19 » 3 novembre 2019, 21:26

Bonsoir Theze,

un immense merci pour votre aide mais je pense que je suis dépassé par le niveau de compétence (je vais prendre des cours).
j'aurai voulu le même tableau que celui en PJ mais avec un envoi par outlook.
Si vous avez la solution je suis prenant sinon je me contenterai de votre premier tableau qui fonctionne très bien.
Merci encore pour votre aide
Bien à vous
Mango19
TEST couleur PROCEDURE ALERTE v1 (22).xlsm
(22.17 Kio) Téléchargé 3 fois
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 4 novembre 2019, 19:49

Bonjour,

Si c'est juste envoyer un petit tableau par mail, tu as cette solution assez simple :
Sub EnvoiMail()

    Dim PlgEnvoi As Range
    
    With Worksheets("MED PB")
        
        Set PlgEnvoi = .Range("A2:D10")
    
        PlgEnvoi.Select
        ThisWorkbook.EnvelopeVisible = True
        
        With .MailEnvelope
        
            .Item.Subject = "Médicaments périmés. Société MANGO ;-)"
             
            .Introduction = "Bonjour," & _
                            Chr(13) & Chr(13) & _
                            "Les produits ci-dessous sont périmés." & _
                            Chr(13) & Chr(13) & _
                            "Très cordialement." & _
                            Chr(13) & Chr(13) & _
                            "MANGO19"
                           
            .Item.To = "destinataire@hebergeur.fr" '<--- adapter l'adresse !
            .Item.Send
       
        End With
    
    End With
        
End Sub
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
M
MANGO19
Membre habitué
Membre habitué
Messages : 117
Inscrit le : 6 janvier 2019
Version d'Excel : 2007

Message par MANGO19 » 4 novembre 2019, 20:01

Bonsoir Theze,

Merci Theze pour votre aide, le code que vous m'avez envoyé remplace quoi? :oops:

j'ai l'impression qu'il y a deux problèmes :
1) le code couleur

'si le texte est vide, pas de produit périmés, fin de procédure
If Texte1 = "" And texte2 = "" And texte3 = "" Then Exit Sub
'SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbBlack
CustomMsgBox "Les éléments suivants seront périmés dans moins de 30 jours :<p style='color:red'><br>>" & Texte1 & _
"</p><br>Les éléments suivants seront périmés dans moins de 60 jours :<p style='color:orange'>" & texte2 & _
"</p><br>Les éléments suivants seront périmés dans moins de 90 jours :<p style='color:green'>" & texte3 & "</p>"
'Texte = Left(Texte, Len(Texte) - 3)
'MsgBox Texte
'EnvoiMail Texte

2) le lien avec customMsgBox car il est relié à la couleur et à l'envoi d'un message par IE alors que moi je voudrais un mail en couleur via la boite outlook

Sub CustomMsgBox(msg)
Set ie = CreateObject("InternetExplorer.Application")
ie.Navigate "about:blank"

' While ie.ReadyState <> 4: WScript.Sleep 100: Wend

ie.Toolbar = False
ie.StatusBar = False
ie.Width = 600
ie.Height = 420

ie.document.body.innerHTML = "<p class='msg'>" & msg & "</p>" & _
"<p class='ctrl'><input type='hidden' id='OK' name='OK' value='0'>" & _
"<input type='submit' value='OK' id='OKButton' " & _
"onclick='document.all.OK.value=1'></p>"



Set Style = ie.document.CreateStyleSheet
Style.AddRule "p.msg", "font-weight:bold;"
Style.AddRule "p.ctrl", "text-align:rightf;"

ie.Visible = True

On Error Resume Next
Do While ie.document.all.OK.Value = 0
WScript.Sleep 200
Loop
ie.Quit
End Sub

Cordialement
Mango19
TEST couleur PROCEDURE ALERTE v1 (22).xlsm
(22.17 Kio) Téléchargé 5 fois
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 4'020
Appréciations reçues : 305
Inscrit le : 26 janvier 2011
Version d'Excel : 2007/2019

Message par Theze » 4 novembre 2019, 20:49

j'aurai voulu le même tableau que celui en PJ mais avec un envoi par outlook.
c'est exactement ce que fais le code que je viens de te donner !
le lien avec customMsgBox car il est relié à la couleur et à l'envoi d'un message par IE alors que moi je voudrais un mail en couleur via la boite outlook
Le code que je t'ai donné le 01 nov. 2019 à 19:39 envoi bien le message en html donc en couleur mais tu as apparemment changé le sens des colonnes donc, voici le code adapté à ton dernier fichier :
Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim DateLimite As Date
    Dim Texte As String
    Dim Texte1 As String
    Dim Texte2 As String
    Dim Texte3 As String

    With Worksheets("MED PB")

        Set Plage = .Range(.Cells(3, 4), .Cells(.Rows.Count, 4).End(xlUp))
        DateLimite = .Cells(1, 4).Value

    End With

    'boucle et construit le texte pour les produits périmés en HTML
    For Each Cel In Plage

        If Cel.Value < (DateLimite + 30) Then
             
             Texte1 = Texte1 & "<b>" & "-" & Cel.Offset(, -3).Value & " " & Cel.Offset(, -2).Value & " " & Cel.Value & "</b><br>"
             
        ElseIf Cel.Value < (DateLimite + 60) Then
        
             Texte2 = Texte2 & "<b>" & "-" & Cel.Offset(, -3).Value & " " & Cel.Offset(, -2).Value & " " & Cel.Value & "</b><br>"
            
        ElseIf Cel.Value < (DateLimite + 90) Then
        
             Texte3 = Texte3 & "<b>" & "-" & Cel.Offset(, -3).Value & " " & Cel.Offset(, -2).Value & " " & Cel.Value & "</b><br>"
            
        End If

    Next Cel

    'si le texte est vide, pas de produit périmés, fin de procédure
    If Texte1 = "" And Texte2 = "" And Texte3 = "" Then Exit Sub
    
    'début de construction du texte en HTML
    Texte = "<html><body><p>Bonjour,</p>"
    Texte = Texte & IIf(Texte1 <> "", "<p>Les éléments suivants seront périmés dans moins de 30 jours :<br><font color=Red>" & Texte1 & "</font><br></p>", "")
    Texte = Texte & IIf(Texte2 <> "", "<p>Les éléments suivants seront périmés dans moins de 60 jours :<br><font color=orange>" & Texte2 & "</font><br></p>", "")
    Texte = Texte & IIf(Texte3 <> "", "<p>Les éléments suivants seront périmés dans moins de 90 jours :<br><font color=green>" & Texte3 & "</font><br></p>", "")
    Texte = Texte & "<p>Très cordialement.</p><p>Mango</p></body></html>"
        
    EnvoiMail Texte

End Sub


Sub EnvoiMail(Texte As String)
        
    Dim AppOutlook As Object
    Dim OutMail As Object
    
    Set AppOutlook = CreateObject("Outlook.Application")
    Set OutMail = AppOutlook.CreateItem(0)
    
    With OutMail
        
        'adresses des deux personnes à adapter !
        .To = "adressepersonne_1@orange.fr" & ";" & "adressepersonne_2@orange.fr"
        
        .Subject = "Médicaments périmés. Société MANGO ;-)"
                
        .HTMLBody = Texte 'il te faut indiquer à Outlook que tu veux du HTML !
                    
        'affiche le message
        .Display
        
        '.Send '<--- enlever l'apostrophe pour que le mail soit envoyé automatiquement !
        
    End With
    
    Set OutMail = Nothing
    Set AppOutlook = Nothing

End Sub
Il vaut mieux un qui sait que cent qui cherchent :wink:

Ce forum étant un lieu de partage, je n'accepte pas les messages privés !
M
MANGO19
Membre habitué
Membre habitué
Messages : 117
Inscrit le : 6 janvier 2019
Version d'Excel : 2007

Message par MANGO19 » 5 novembre 2019, 07:05

Bonjour Theze,

l'envoi via outlook fonctionne mais le résultat donne :

Bonjour,
Les produits ci-dessous sont périmés :
<html><body><p>Bonjour,</p><p>Les éléments suivants seront périmés dans moins de 30 jours :<br><font color=Red><b>-20 PARACETAMOL 21/11/2019</b><br><b>-30 PROPANOLOL 22/11/2019</b><br><b>-60 LOPERAMIDE3 25/11/2019</b><br></font><br></p><p>Les éléments suivants seront périmés dans moins de 60 jours :<br><font color=orange><b>-40 KETOPROFENE 22/12/2019</b><br></font><br></p><p>Les éléments suivants seront périmés dans moins de 90 jours :<br><font color=green><b>-50 IBUPROFENE 23/01/2020</b><br><b>-60 LOPERAMIDE1 24/01/2020</b><br><b>-60 LOPERAMIDE2 25/01/2020</b><br></font><br></p><p>Très cordialement.</p><p>Mango</p></body></html>

un immense merci pour votre aide précieuse

Amicalement
Mango19
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message