Microsoft 365 Envoie mail automatique

vby · 4 Mai 2023

Bonsoir cher Forum

Je voudrais que vous m'appuyez à corriger ce code VBA. JE voudrais que si la valeur des cellules AB3 à AB100 est comprise entre 0 et 30 qu'il envoie un mail automatique à l'émail figurant sur la colonne Z en mettant en objet le nom de la colonne H. pour le corps du message il commencera par Bonjour + le nom de la cellule à F.

Exemple1: si AB4 = 27, qu'il envoie un mail à Z4 avec comme :

Objet Mettre à jour date fin contrat H4
et comme corps du message : Bonjour cher.e F4,
Juste un petit rappel que le contrat H4 prend fin à K4.
Cordialement

Exemple1: si AB30 = 1, qu'il envoie un mail à Z30 avec comme :

Objet Mettre à jour date fin contrat H30
et comme corps du message : Bonjour cher.e F30,
Juste un petit rappel que le contrat H30 prend fin à K30.
Cordialement

Je voudrais que cela se produit qu'une seule fois par jour lors de la première ouverture du fichier. De plus si la cellule à la colonne AB est comprise entre 0 et 30 qu'il colorie en rouge la cellule K correspondante.

Merci de votre précieuse aide !

Ci dessous le code j'avais entamé :

Private Sub Workbook_Open()

Dim OutApp As Object
Dim OutMail As Object
Dim strBody As String
Dim toEmail As String
Dim i As Integer

For i = 3 To 54
If Range("AB" & i).Value = 0 Then
If Not IsEmpty(Range("Z" & i).Value) Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
toEmail = Range("Z" & i).Value

strBody = "Bonjour, " _
& "La valeur de la cellule AB" & i & " est égale à 0. " _
& "Cordialement, " _
& "Votre nom"

On Error Resume Next

With OutMail
.To = toEmail
.CC = ""
.BCC = ""
.Subject = "Sujet de l'e-mail"
.HTMLBody = strBody
.Send
End With

On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End If
End If
Next i

End Sub

Phil69970 · 4 Mai 2023

Bonjour @vby

Je te propose ce fichier

==> Ne pas déplacer les cellules Z1 et AA1

Merci de ton retour

@Phil69970

vby · 4 Mai 2023

Merci beaucoup @Phil69970 !

Mais rien ne se produit à l'ouverture du classeur.

Phil69970 · 4 Mai 2023

@vby

C'est normal mais efface la cellule AA1 referme le fichier en l'enregistrant

Réouvre le fichier et regarde

@Phil69970

vby · 4 Mai 2023

@Phil69970
il affiche une notification à l'ouverture mais n'envoie pas de mail. De plus il signale juste une cellule qui une valeur entre 0 et 30, alors pour l'exemple il y a 3 cellules concernées.

Ci joint les captures

Phil69970 · 4 Mai 2023

@vby

Le message c'est pour mes tests et que tu vois ce qui va être dans le corps du mail
L'instruction Stop j'ai oublié de l'enlever c'est pour stopper le code avant l'envoi du mail. Tu peux la supprimer

@Phil69970

vby · 4 Mai 2023

@Phil69970

Merci ca marche. Mais est ce possible qu'il envoie automatiquement les mails sans que je les consulte ?

Est ce possible aussi pour le corps du message qu'il va à la ligne pour plus de visibilité par exemple il affiche ca:

Bonjour cher.e CB,Juste un petit rappel que le contrat A6 prend fin à 01/06/2023Cordialement,

or moi je veux qu'il l'affiche comme ca :

Bonjour cher.e CB,

Juste un petit rappel que le contrat A6 prend fin à 01/06/2023

Cordialement,

Phil69970 · 4 Mai 2023

@vby

Dans cette version plus de message

vby à dit:
Mais est ce possible qu'il envoie automatiquement les mails sans que je les consulte ?

Et un essai sans garantie pour la présentation

Merci de ton retour

@Phil69970

vby · 6 Mai 2023

Merci beaucoup @Phil69970

Ca marche à merveille!

J'ai retravaillé le code comme suit :

VB:

Private Sub Workbook_Open()
    Dim OutApp As Object, OutMail As Object
    Dim strBody$, toEmail$, ccEmail$, i%
    
    'Boucle sur les lignes
    For i = 3 To 200
        'Vérifie que la cellule XER contient une valeur comprise entre 0 et 30 et que la cellule G n'est pas vide
        If Range("XER" & i).Value >= 0 And Range("XER" & i).Value <= 30 And Not IsEmpty(Range("G" & i).Value) Then
            
            'Affiche un message box avec les informations nécessaires
            MsgBox "Cher.e " & Range("F" & i) & "," & vbCrLf & _
                "Juste un petit rappel que le contrat " & Range("J" & i) & " prend fin au " & Range("M" & i) & vbCrLf & vbCrLf & _
                "Cordialement, " & vbCrLf & vbCrLf & _
                " Consulter les lignes colorées en rouge svp"
            
            'Envoie l'e-mail
            On Error Resume Next
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            toEmail = Range("G" & i).Value
            ccEmail = Range("H" & i).Value
            
            strBody = "Bonjour cher.e " & Range("F" & i) & "," & vbCrLf & _
                "Juste un petit rappel que le contrat " & Range("J" & i) & " prend fin au " & Range("M" & i) & vbCrLf & vbCrLf & _
                "Cordialement, " & vbCrLf & vbCrLf & _
                "Ceci est un message automatique merci de ne pas y répondre"
            
            With OutMail
                .To = toEmail
                .CC = ccEmail
                .Subject = Range("J" & i) & ": Mettre à jour date fin contrat dans la Masterlist 2023"
                .Body = strBody
                .Send
            End With
            
            Set OutMail = Nothing: Set OutApp = Nothing
            
            'Colorie en rouge les lignes où la valeur d'XER est comprise entre 0 et 30
              
            If Range("XER" & i).Value >= 0 And Range("XER" & i).Value <= 30 Then
                Range("A" & i & ":AAZ" & i).Interior.Color = vbRed
            End If
        End If
            
    Next i
    
    Sheets("MasterList 2023").Protect password:="master"
    
End Sub

Seulement je n'arrive à reproduire qu'il envoie le mail juste lors de la première ouverture de la journée et de manière journalière !
Encore merci à toi !

Phil69970 · 6 Mai 2023

@vby

vby à dit:
Seulement je n'arrive à reproduire qu'il envoie le mail juste lors de la première ouverture de la journée et de manière journalière !

As tu essayé mon fichier sans le modifier pour voir ce qu'il fait ?

==> Je pense qu'il fait ce que tu as demandé !

Merci de ton retour

@Phil69970

vby · 6 Mai 2023

@Phil69970
Oui j'ai essayé et il le fait bien.
Mais j'ai essayé d'adapter le code sur le vrai fichier qui a des infos personnelles

Je vous partage le fichier d'adaptation dont j'ai essayé de retravaillé le à l'aide Chat Gpt :

VB:

Private Sub Workbook_Open()
    Dim OutApp As Object, OutMail As Object
    Dim strBody$, toEmail$, ccEmail$, i%
    
    'Boucle sur les lignes
    For i = 3 To 200
        'Vérifie que la cellule XER contient une valeur comprise entre 0 et 30 et que la cellule G n'est pas vide
        If Range("XER" & i).Value >= 0 And Range("XER" & i).Value <= 30 And Not IsEmpty(Range("G" & i).Value) Then
            
            'Affiche un message box avec les informations nécessaires
            MsgBox "Cher.e " & Range("F" & i) & "," & vbCrLf & _
                "Juste un petit rappel que le contrat " & Range("J" & i) & " prend fin au " & Range("M" & i) & vbCrLf & vbCrLf & _
                "Cordialement, " & vbCrLf & vbCrLf & _
                " Consulter les lignes colorées en rouge svp"
            
            'Envoie l'e-mail
            On Error Resume Next
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            toEmail = Range("G" & i).Value
            ccEmail = Range("H" & i).Value
            
            strBody = "Bonjour cher.e " & Range("F" & i) & "," & vbCrLf & _
                "Juste un petit rappel que le contrat " & Range("J" & i) & " prend fin au " & Range("M" & i) & vbCrLf & vbCrLf & _
                "Cordialement, " & vbCrLf & vbCrLf & _
                "Ceci est un message automatique merci de ne pas y répondre"
            
            With OutMail
                .To = toEmail
                .CC = ccEmail
                .Subject = Range("J" & i) & ": Mettre à jour date fin contrat dans la Masterlist 2023"
                .Body = strBody
                .Send
            End With
            
            Set OutMail = Nothing: Set OutApp = Nothing
            
            'Colorie en rouge les lignes où la valeur d'XER est comprise entre 0 et 30
              
            If Range("XER" & i).Value >= 0 And Range("XER" & i).Value <= 30 Then
                Range("A" & i & ":AAZ" & i).Interior.Color = vbRed
            End If
        End If
            
    Next i
    
    Sheets("MasterList 2023").Protect password:="master"
    
End Sub

Phil69970 · 6 Mai 2023

@vby

Quelques remarques :

Tu n'as pas compris mon code qui permet d'envoyer 1 mail à l'ouverture et 1 seul par jour

Pourtant j'avais bien pris soin d'écrire

Phil69970 à dit:
==> Ne pas déplacer les cellules Z1 et AA1

Si j'ai écris cela c'est pas pour le fun !!!

Dans ton fichier du post #1 la cellule Z1 contient la date du jour je m'en sers pour comparer avec la date que j'ai mis en AA1 si il y une différence c'est que nous avons changé de jour et donc je peux lancé la macro avec les mails ET si c'est la même date c'est donc le même jour .... CQFD

Dans ton code du post #9 et 11 tout cela à disparu !!!!
==> Donc c'est un normal que cela ne fonctionne plus !!!

Bien sur tu peux choisir d'autres cellules et adapter le code en conséquence...

Autre chose si en fin de macro tu mets un MDP je m'attends à voir en début de macro une ligne de code pour enlever le MDP

vby à dit:
Sheets("MasterList 2023").Protect password:="master"

Et sauf erreur de ma part j'ai rien vu de tel !!!

De plus quand on fournit un fichier il doit être représentatif
C'est quoi représentatif ?

- représentatif, même organisation des lignes et des colonnes, mêmes libellés, mêmes noms de feuilles...
- anonymisé, pas de données personnelles réelles tels nom, n° sécu, adresse ... remplacé par Nom1, Nom2 etc ....
- simplifié, une quinzaine de lignes reproduisant l'ensemble des différents cas envisageables (Avec le résultat souhaité éventuellement)

*Préciser l'ordre de grandeur des lignes à traiter, exemple mon fichier comporte 1 000 lignes ou bien 200 000 lignes ==> la méthodologie peut être différents.

Une demande claire donne très souvent une réponse rapide et qui correspond au mieux à la demande.

Si cela fonctionne sur le fichier fourni et pas sur le vrai fichier c'est qu'il n'est en rien représentatif ou que tu n'as pas su transposer ce qui devrait être un simple copier coller du code.

Arriveras tu à faire la macro sur ton fichier avec toutes les infos que je t’ai donné ?
Sinon je te le ferais ....

Merci de ton retour

@Phil69970

vby · 6 Mai 2023

@Phil69970
Vous avez parfaitement raison. Erreur de débutant !
Je suis un grand débutant à vba c'est pourquoi je n'ai pas compris votre code.
Mais le fichier représentatif est celui que je viens de partager dernièrement si ca peut toujours aider.

Phil69970 · 6 Mai 2023

@vby

Phil69970 à dit:
Arriveras tu à faire la macro sur ton fichier avec toutes les infos que je t’ai donné ?
Sinon je te le ferais ....

Sinon je le ferais mais ....demain...car maintenant ==> dodo

@Phil69970

vby · 6 Mai 2023

Phil69970 à dit:
@vby

Sinon je le ferais mais ....demain...car maintenant ==> dodo

@Phil69970

@Phil69970
Je vais essayer. Sinon je patienterai pour demain.
Un grand merci

Microsoft 365 Envoie mail automatique

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Partager cette page

Statistiques des forums