XL 2016 Macro VBA - Envoi mail automatique selon plusieurs échéances

[LuanaDDC]

Bonjour à tous,

J'espère que vous allez bien.

J'aurais besoin de vos précieux conseils, s'il vous plait pour m'aiguiller dans ma problématique qui peut paraître un peu complexe .

Je souhaite faire une macro qui envoi un mail automatiquement sur Outlook à une liste de mail, qui sera défini au préalable dans ma colonne H, un mail lorsque :
- Jours restants = 15
- Jours restants = 7
- Jours restants = 0
- Jours restants = -7
- Jours restants = -15

- Jours restant = -30 ou -31 (à la fin du mois)Ps: je sais ça fait beaucoup de relance ^^' mais c'est fait exprès.Concernant les jours restants "négatives", je souhaite intégrer dans ma formule deux adresses mails automatiques en plus de ceux qui sont mentionnés dans la colonne H (il me semble que je peux les insérer directement dans ma macro pour ce point). Ci-dessous un exemple du mon fichier.

Ci-dessous une macro que j'ai essayé d'adapter sauf que du coup je n'ai pas mes rappels et relances... Je ne sais pas si je dois mettre Option Explicit ou si je peux rajouter directement à la suite de If C.Offset(, 1) - Date = 15 avec un Else...

Le code ne veut rien ! ahah

Option Explicit Const cSheetName ="Feuil1" Const cColJoursRestants=15 Const cColMailRappel = 7 ConstcNbJoursJ = 0 Const cNbJoursRappel = -7 ConstcNbJoursRappel1 = -15 Const cNbJoursRappel2 = -30 Sub Alertes() Dim C As Range, OL As Object, M As Object, Plage As Range Set olApp = CreateObject("Outlook.application") With Sheets("Feuil1") Set Plage = .Range(.[G2], .Cells(.Rows.Count, 1).End(xlUp)) End With For Each C In Plage If C.Offset(, 1) - Date = 15 Then Set M = olApp.CreateItem(olMailItem) With M .Subject = C.Offset(, 3) .Body = C.Offset(, 4) .Recipients.Add C.Offset(, 2) '.display .Send End With End If Next C End Sub

En tout cas merci beaucoup par avance pour votre aide. J'espère avoir été assez clair... Et désolée je suis débutante mais j'ai vraiment envie d'être autonome ^^ et pouvoir aider les autres par la suite.

Bonne soirée !

Cordialement.

 

[youky(BJ)]

Bonjour,
Voici un code qui le fait.
Supprimer tout le contenu de Module1 et coller ce code
Adapter le lieu ou ce situe le message
.Subject = Feuil2.[D2] 'le message
Bruno

Sub EnvoieMail()
Dim OutApp As Object
Dim OutMail As Object
For lig = 2 To [C65000].End(3).Row
n = Date - Cells(lig, 6)
If n = -15 Or n = -7 Or n = 0 Or n = 7 Or n = 15 Then
noms = noms & ";" & Cells(lig, 8)
End If
Next
noms = Right(noms, Len(noms) - 1)
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "DA-COSTA"
        .Cc = noms
       ' .Attachments.Add (rep & "\" & NomFic)
        .Subject = Feuil2.[D2] 'le message
        .Body = "RELANCE CONTROL" 'le titre
        .Display
        .Send
    End With
End Sub

 

[youky(BJ)]

Petite correction pour éviter si rien car bug
et mettre la date d'envoie
Bruno

Sub EnvoieMail()
Dim OutApp As Object
Dim OutMail As Object
For lig = 2 To [C65000].End(3).Row
n = Date - Cells(lig, 6)
If n = -15 Or n = -7 Or n = 0 Or n = 7 Or n = 15 Then
noms = noms & ";" & Cells(lig, 8)
Cells(lig, 9) = Date
End If
Next
If noms = "" Then MsgBox "Rien envoyé", vbInformation, "AUCUNE RELANCE": Exit Sub
noms = Right(noms, Len(noms) - 1)
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "DA-COSTA"
        .Cc = noms
       ' .Attachments.Add (rep & "\" & NomFic)
        .Subject = Feuil2.[D2] 'le message
        .Body = "RELANCE CONTROL" 'le titre
        .Display
        .Send
    End With
End Sub

 

[LuanaDDC]

Bonjour,

Merci beaucoup pour votre retour ! Je vais essayer.

J'ai une question, s'il vous plait, le code prends bien en compte les adresses mails qui seront mentionnés dans ma colonne H ? Par ailleurs, concernant la relance +7 et +15, il faut que je rajoute mes adresses mails supplémentaires dans .To ? Ou vous me conseillez de les écrire dans une cellule masqué et prendre la colonne ?

En vous remerciant encore une fois !

Bonne journée.

 

[youky(BJ)]

Bonjour
Le mieux est de créer une colonne supplémentaire pour y mettre la 2ème adresse(même masquée)
Voici un code qui si la diff est plus grande de 0 don 7 ou 15 on prend l'adresse en col J sinon en col H
Bruno

Sub EnvoiMail()
Dim OutApp As Object
Dim OutMail As Object
For lig = 2 To [C65000].End(3).Row
n = Date - Cells(lig, 6)
If n = -15 Or n = -7 Or n = 0 Or n = 7 Or n = 15 Then
'''''''''si n >0 prend adresse en col J sinon en col H
noms=iif(n>0,noms & ";" & cells(lig,10),noms & ";" & cells(lig,8))
'noms = noms & ";" & Cells(lig, 8)
Cells(lig, 9) = Date
End If
Next
If noms = "" Then MsgBox "Rien envoyé", vbInformation, "AUCUNE RELANCE": Exit Sub
noms = Right(noms, Len(noms) - 1)
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "DA-COSTA"   'nom de la boite
        .Cc = noms
       ' .Attachments.Add (rep & "\" & NomFic)
        .Subject = Feuil2.[D2] 'le message à adapter
        .Body = "RELANCE CONTROL" 'le titre
        .Display
        .Send
    End With
End Sub

 

[LuanaDDC]

Merci beaucoup pour l'astuce !
Je vais rajouter quelques données supplémentaires.

Bonne journée !
Encore merci.