Microsoft 365 MsgBoxPerso et envoi de mail auto

[ExcLnoob]

Bonjour le Forum,

Bon j'ai encore fait n'importe quoi je crois...
J'ai un fichier avec des prestations et des dates d'échéance pour chaque prestations. J'ai implémenté une macro qui m'ouvre 2 MsgBoxPerso quand :
1/ Les dates arrivent à échéance
2/ Les dates sont échues
J'ai essayé d'intégrer une macro d'envoi de mail sur le bouton valider des 2 MsgBoxPerso.

Cela fonctionne mais je rencontre 2 erreurs :
1/ Quand les dates sont échues (MsgBoxPerso((txt), "Alerte", vbCritical, "xxxx", "xxxxx") pour l'exemple) le mail s'ouvre bien mais le texte de la MsgBox lui ne remonte pas, ou plutôt je le vois furtivement mais il disparait
Le message pour les dates échues ne s'affiche que si les 2 MsgBoxPerso sont activées (cad uniquement s'il y a des dates échues ET qui arrivent à échéance)

2/Quand il y a des dates échues ET qui arrivent à échéance et que j'envoi un mail un chaque fois, tout va bien. Mais si je choisi de ne pas envoyer le premier mail la deuxième MsgBoxPerso s'affiche comme une MsgBox normale (et fais quand même l'action demandé).

A mon avis je place mal mes bouts de code dans la deuxième partie de celui-ci mais ça n'engage que moi. N'est pas Harry Potter qui veut... #apprentisorcierpastrèsdoué

Si vous pouviez me dire où j'ai fauté....
Merci pour vos explications !!

Le code en question :
Private Sub Worksheet_Activate()
Dim c As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMail = OutlookApp.createitem(0)
txt = ""
txt1 = ""
With Sheets("Feuil1")
For Each c In Range(.[P3], [P65536].End(xlUp))
If c <> "" Then
If c.Value < Date Then
If txt = "" Then txt = "Les dates ci-dessous sont échues :" & vbCrLf & vbCrLf
txt = txt & c.Offset(, -12) & " - Terminée le : " & c.Offset(, 0) & vbCrLf
ElseIf c.Value < Date + 30 Then
If txt1 = "" Then txt1 = "Les dates ci-dessous arrivent à échéance dans 1 mois ou moins :" & vbCrLf & vbCrLf
txt1 = txt1 & c.Offset(, -12) & " - Arrive à écheance le : " & c.Offset(, 0) & vbCrLf
End If
End If
Next c
If txt <> "" Then Rep = MsgBoxPerso((txt), "Alerte", vbCritical, "Envoi Mail", "Ne rien faire")
Select Case Rep
Case 1
With OutlookMail
.Subject = "Des prestations nécessitent votre attention"
.To = Sheets("Feuil2").Range("F7")
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
.Display
End With
End Select
If txt1 <> "" Then Rep = MsgBoxPerso((txt1), "Information", vbInformation, "Envoi Mail", "Ne rien faire")
Select Case Rep
Case 1
With OutlookMail
.Subject = "Des prestations nécessitent votre attention"
.To = Sheets("Infos Utiles Mali").Range("F10")
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
.Display
End With
End Select
End With
End Sub

 

[patricktoulon]

bonsoir
il faudrait que tu nous explique ce qu'est réellement msgboxperso
si c'est un msgbox il n'a rien a faire dans le body du mail

 

[ExcLnoob]

Oui effectivement....
MsgBoxPerso c'est une MsgBox avec des boutons customisé.
Au lieu de Oui/Non/Annuler ou autre, les boutons sont du style "Cest bien"/C"est pas bien", etc...
MsgBoxPerso "généré" via le code suivant dans un module :

Private Declare Function SetWindowsHookEx& Lib "USER32" Alias "SetWindowsHookExA" _
(ByVal idHook&, ByVal lpfn&, ByVal hmod&, ByVal dwThreadId&)
Private Declare Function GetCurrentThreadId& Lib "kernel32" ()
Private Declare Function CallNextHookEx& Lib "USER32" _
(ByVal hHook&, ByVal CodeNo&, ByVal wParam&, ByVal lParam&)
Private Declare Function GetWindow& Lib "USER32" (ByVal hWnd&, ByVal wCmd&)
Private Declare Function SetWindowText& Lib "USER32" Alias "SetWindowTextA" _
(ByVal hWnd&, ByVal lpString$)
Private Declare Function UnhookWindowsHookEx& Lib "USER32" (ByVal hHook&)
Private msgHook&
Private TitreBtn$(1 To 2)

Function MsgBoxPerso(Prompt$, Optional Title$, Optional Icon&, Optional Caption1$ = "Oui", _
Optional Caption2$ = "Non", Optional Cancel As Boolean = False) As Byte
Dim Rep%, hInstance&
TitreBtn(1) = Caption1
TitreBtn(2) = Caption2
msgHook = SetWindowsHookEx(5, AddressOf CaptionBoutons, hInstance, GetCurrentThreadId())
Rep = MsgBox(Prompt, Icon + IIf(Cancel, vbYesNoCancel, vbYesNo), Title)
MsgBoxPerso = Application.Max(Rep - 5, 0)
Erase TitreBtn
End Function

Private Function CaptionBoutons&(ByVal nCode&, ByVal wParam&, ByVal lParam&)
Dim hWndChild&
If nCode < 0 Then
CaptionBoutons = CallNextHookEx(msgHook, nCode, wParam, lParam)
Exit Function
End If
If nCode = 5 Then
hWndChild = GetWindow(wParam, 5)
Call SetWindowText(hWndChild, TitreBtn(1))
hWndChild = GetWindow(hWndChild, 2)
Call SetWindowText(hWndChild, TitreBtn(2))
UnhookWindowsHookEx msgHook
End If
CaptionBoutons = False
End Function

 

[Dudu2]

Bonsoir,
Je vois pas pourquoi tu t'em...bêtes avec un MsgBoxPerso alors qu'il te suffit de poser la bonne question dans un simple MsgBox et d'utiliser l'une des 6 combinaisons boutons proposées dans

Fonction MsgBox (Visual Basic pour Applications)

Référence de langage VBA pour Office

docs.microsoft.com

Rep = MsgBoxPerso((txt1), "Information", vbInformation, "Envoi Mail", "Ne rien faire")
Rep = MsgBox("Envoyer le Mail ?", vbYesNo + vbQuestion + vbDefaultButton2)

En plus je suis sûr que patricktoulon va te dire que ces machins qui Hookent c'est pas la panacé.

S'il te fallait vraiment un MsgBoxPerso (mais il ne t'en faut pas), coïncidence, je viens juste d'en finaliser un (et un InputBoxPerso aussi) sur la base d'un UserForm, donc sans Hook.

 

[Dudu2]

Et en effet, cette instruction n'a pas de sens:
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"

 

[ExcLnoob]

@Dudu2
Oui my mistake....
.Body = "Bonjour," & vbCrLf & vbCrLf & MsgBoxPerso & vbCrLf & "Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
C'était pour faire un essai.
MsgBoxPerso doit être remplacé par txt pour faire remonter le texte de la MsgBoxPerso

Effectivement je pourrai utiliser une MsgBox classique mais j'avoue ne pas avoir tester de mettre une ligne supplémentaire après mon texte (en sautant une ligne pour plus de lisibilité...), indiquant "Voulez-vous envoyer un Mail".

Cela résoudrait-il mon problème ?

SI tel est le cas, j'avoue (encore) ne pas arriver à strucuturer mon message. A écrire ma phrase en sautant une ligne en dessous de txt.

 

[Dudu2]

Cela résoudrait-il mon problème ?

Je ne sais pas vraiment quel est le problème alors...
Déjà essaie de placer du code dans une zone de code en utilisant </> dans le menu qu'on puisse le lire avec indentation et en retirant les essais infructueux que tu as faits.

 

[ExcLnoob]

Merci pour le temps que vous consacrez à ma question.

Comme évoqué par image dans mes précédents messages, je ne suis pas sachant comme vous semblez l'être et je vous envie grandement...

J'ai essayé d'utiliser une MsgBox normale mais la mise en forme ne me convient pas. En effet, je souhaite insérez une phrase, en sautant une ligne pour plus de lisibilité, après mon txt et mon txt1
mais au lieu de cela j'ai cette phrase après chaque txt ou txt1
txt =
"Les dates ci-dessous sont échues :" & vbCrLf & vbCrLf
txt = txt & c.Offset(, -12) & " - Terminée le : " & c.Offset(, 0) & vbCrLf
ou
txt1 =
"Les dates ci-dessous arrivent à échéance dans 1 mois ou moins :" & vbCrLf & vbCrLf
txt1 = txt1 & c.Offset(, -12) & " - Arrive à écheance le : " & c.Offset(, 0) & vbCrLf

J'ai essayé de contourner en mettant cette fameuse phrase directement dans le bouton de la MsgBox en passant via Hook et MsgBoxPerso. cela ne semble pas optimal, ce que je comprends mais le résultat est là.
Cependant, comme évoqué, j'ai 2 "erreurs".

Je joins un fichier pour exemple car malgré que cela semble evident je ne sais pas placer du code dans une zone de code en utilisant </> dans le menu.

Vous remarquerez :
1/ Quand les dates sont uniquement échues, il n'y donc qu'un MsgBoxPerso, le mail s'ouvre bien mais le texte de la MsgBoxPerso lui, ne remonte pas dans le mail.

2/Quand il y a des dates échues ET qui arrivent à échéance et que l'on clique sur "Envoi mail" sur la première MsgBoxPerso tout se passe bien mais la 2è MsgBoxPerso n'est plus formaté de la même manière, c'est une MsgBox normale.

Ou ai-je fauté ?
Et désolé si je ne fais pas les choses correctement, je vais creuser pour changer tout ça...
Merci

 

[patricktoulon]

re

En plus je suis sûr que @patricktoulon va te dire que ces machins qui Hookent c'est pas la panacé.

ben pour ceux qui maîtrise pas non

et je réitère en core une fois ton msgbox (perso ou pas) n'a rien a faire dans le concat du string du body du mail
elle est là ton erreur !!!!!

 

[Dudu2]

1/ Quand les dates sont uniquement échues, il n'y donc qu'un MsgBoxPerso, le mail s'ouvre bien mais le texte de la MsgBoxPerso lui, ne remonte pas dans le mail.

Qu'est-ce qui devrait remonter et qui ne remonte pas ?

2/Quand il y a des dates échues ET qui arrivent à échéance et que l'on clique sur "Envoi mail" sur la première MsgBoxPerso tout se passe bien mais la 2è MsgBoxPerso n'est plus formaté de la même manière, c'est une MsgBox normale.

Non, il n'y a pas de MsgBox normal dans ton code, c'est bien le 2ème MsBoxPerso qui affiche Txt1.
La seule différence avec le MsgBoxPerso précédent c'est que tu as mis vbInformation et non vbCritical comme choix d'icone de message.

Si tu écris un code à plat c'est indéchiffrable. Il faut indenter ton code.

Private Sub Worksheet_Activate()
    Dim c As Range
    Dim OutlookApp As Object
    Dim OutlookMail As Object
  
    Set OutlookApp = CreateObject("outlook.application")
    Set OutlookMail = OutlookApp.createitem(0)
    txt = ""
    txt1 = ""
  
    With Sheets("Feuil1")
        For Each c In Range(.[C1], [C65536].End(xlUp))
            If c <> "" Then
                If c.Value < Date Then
                    If txt = "" Then txt = "Les dates ci-dessous sont échues :" & vbCrLf & vbCrLf
                    txt = txt & c.Offset(, -2) & " - Terminée le : " & c.Offset(, 0) & vbCrLf
                ElseIf c.Value < Date + 30 Then
                    If txt1 = "" Then txt1 = "Les dates ci-dessous arrivent à échéance dans 1 mois ou moins :" & vbCrLf & vbCrLf
                    txt1 = txt1 & c.Offset(, -2) & " - Arrive à écheance le : " & c.Offset(, 0) & vbCrLf
                End If
            End If
        Next c
      
        If txt <> "" Then Rep = MsgBoxPerso((txt), "Alerte", vbCritical, "Envoi Mail", "Ne rien faire")
      
        Select Case Rep
            Case 1
                With OutlookMail
                    .Subject = "Des prestations nécessitent votre attention"
                    .To = Sheets("Feuil2").Range("A1")
                    .Body = "Bonjour," & vbCrLf & vbCrLf & txt & vbCrLf & "Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
                    .Display
                End With
        End Select
      
        If txt1 <> "" Then Rep = MsgBoxPerso((txt1), "Information", vbInformation, "Envoi Mail", "Ne rien faire")
      
        Select Case Rep
            Case 1
                With OutlookMail
                    .Subject = "Des prestations nécessitent votre attention"
                    .To = Sheets("Feuil2").Range("A1")
                    .Body = "Bonjour," & vbCrLf & vbCrLf & txt1 & vbCrLf & "Merci de renouveler Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
                    .Display
                End With
        End Select
    End With
End Sub

 

[Dudu2]

Et désolé si je ne fais pas les choses correctement, je vais creuser pour changer tout ça...

Il ne faut pas être désolé. On fait les choses correctement quand on a appris à le faire, et encore pas tout le temps, et chaque "génie" de la programmation a son idée du "correctement" qui est en général sa propre manière de faire à l'exclusion de toute autre.

 

[ExcLnoob]

@patricktoulon
Oui, vous avez raison et j'ai corrigé dans mon classeur. Je l'ai remplacé par le Texte du MsgBox (txt ou txt1 mais j'ai toujours mes bugs.

@Dudu2
Ok compris pour le code! Effectivement c'est beuacoup plus lisible.
Pour ce qui est de votre réponse, je suis assez surpris car j'ai bien les "bugs" indiqués (???).

La première erreur intervient s'il n'y a qu'1 date échue dans la liste et pas de date qui arrivent à échéance.
Exemple dans mon classeur :
Si
C1 = 31/12/20
C2 = 31/12/20
C3 = 31/12/19
Et que l'on clique sur "Envoi Mail", il n'apparait pas "Réparation - Terminée le : 31/12/19" dans le corps du mail Outlook contrairement à votre capture d'écran.

Pour le 2è "bug", si :
C1 = 31/12/20
C2 = 30/04/20
C3 = 30/12/19
Et que l'on clique sur "Envoi Mail" dans la première MsgBox vbCritical, Outlook s'ouvre et génère le mail avec tout ce qui va bien mais quand on retourne sur Excel pour la 2è MsgBox vbInformation, celle-ci n'est plus uneMsgBoxPerso.

 

[Dudu2]

Et que l'on clique sur "Envoi Mail", il n'apparait pas "Réparation - Terminée le : 31/12/19" dans le corps du mail Outlook contrairement à votre capture d'écran.

Moi je n'ai rien fait de spécial, j'ai utilisé ton fichier sans modification. Après je ne sais pas pourquoi ça n'apparait pas chez toi, je ne vois aucune raison, sinon un code VBA différent.

pour la 2è MsgBox vbInformation, celle-ci n'est plus uneMsgBoxPerso.

Je ne comprends pas d'où sort ce 2ème message que tu copies ici. Moi je n'ai pas ce message avec Oui / Non. Ce n'est pas le même code qui s'exécute, ce n'est pas possible.

De toutes façons ces MsgBoxPerso sont parfaitement inutiles dans ton code. C'est chercher la complication. Essaie avec ce code.

Option Explicit

Private Sub Worksheet_Activate()
    Dim c As Range
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Dim txt As String
    Dim txt1 As String
    Dim Rep As Variant
   
    Set OutlookApp = CreateObject("outlook.application")
    Set OutlookMail = OutlookApp.createitem(0)
    txt = ""
    txt1 = ""
   
    With Sheets("Feuil1")
        For Each c In Range(.[C1], [C65536].End(xlUp))
            If c <> "" Then
                If c.Value < Date Then
                    If txt = "" Then txt = "Les dates ci-dessous sont échues :" & vbCrLf & vbCrLf
                    txt = txt & c.Offset(, -2) & " - Terminée le : " & c.Offset(, 0) & vbCrLf
                ElseIf c.Value < Date + 30 Then
                    If txt1 = "" Then txt1 = "Les dates ci-dessous arrivent à échéance dans 1 mois ou moins :" & vbCrLf & vbCrLf
                    txt1 = txt1 & c.Offset(, -2) & " - Arrive à écheance le : " & c.Offset(, 0) & vbCrLf
                End If
            End If
        Next c
       
        'If txt <> "" Then Rep = MsgBoxPerso((txt), "Alerte", vbCritical, "Envoi Mail", "Ne rien faire")
        If txt <> "" Then Rep = MsgBox(txt & vbCrLf & "Envoyer le mail ?", vbYesNo + vbCritical, "Alerte")
       
        If Rep = vbYes Then
            With OutlookMail
                .Subject = "Des prestations nécessitent votre attention"
                .To = Sheets("Feuil2").Range("A1")
                .Body = "Bonjour," & vbCrLf & vbCrLf & txt & vbCrLf & "Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
                .Display
            End With
        End If
       
        'If txt1 <> "" Then Rep = MsgBoxPerso((txt1), "Information", vbInformation, "Envoi Mail", "Ne rien faire")
        If txt1 <> "" Then Rep = MsgBox(txt1 & vbCrLf & "Envoyer le mail ?", vbYesNo + vbInformation)
       
        If Rep = vbYes Then
            With OutlookMail
                .Subject = "Des prestations nécessitent votre attention"
                .To = Sheets("Feuil2").Range("A1")
                .Body = "Bonjour," & vbCrLf & vbCrLf & txt1 & vbCrLf & "Merci de renouveler Merci de renouveler vos prestations ci-dessous svp." & vbCrLf & vbCrLf & "Cordialement,"
                .Display
            End With
        End If
    End With
End Sub

 

[ExcLnoob]

J'ai compris... MsgBoxPerso = Pas top
Je viens de modifier et tester
Cela résout le 2ème problème effectivement. Merci !!!
Par contre je ne comprends pas...
Dans le cas 1 cad avec seulement 1 date échue et toutes les autres ok, même avec ton code quand je clique sur oui, le txt de la MsgBox s'affiche furtivement dans mon mail mais s'efface aussitôt. Il n'arrive pas à se fixer.
Il n'y a que ce cas de figure que cela fait ça
Je te remets le fichier avec ton code et la "configuration" (les dates) qui bug au cas ou..
C'est quand même bizarre que ça marche chez toi et pas chez moi.

 

[ExcLnoob]

Je viens de pousser la macro jusqu'à l'envoi et non plus seulement la création du mail.
Alors du coup, quand j'ai 2 MsgBox, 1 pour les dates échues et l'autre pour les dates arrivant à échéance, quand le premier mail est envoyé je reviens automatiquement vers Excel sur la 2è MsgBox et quand je cique sur "Oui" j'ai le message d'erreur ci dessous

et la macro se stoppe sur :
.Subject = "Des prestations nécessitent votre attention"
de la dernière partie du code liée avec txt1