Mail automatique suivant un delai
Bonjour à toutes et tous,
J'ai trouvé des codes pour l'envoie de mail automatique mais je n'arrive pas les appliquer pour mon cas
Donc, j'ai un fichier comportant une colonne de nom et sur les lignes rattachées des dates (cf fichiers joints), j'ai mis des conditions pour que les cellules des dates changent de couleur après un délai . les dates font référence à des activités "trucs" en première ligne , de plus le fichier comporte plusieurs feuilles avec le même tableau (juste les noms différent)
je souhaiterai :
- envoyer automatiquement un mail quand un délai est dépassé
- si possible pas de macro a lancer manuellement
- avoir comme objet du mail "le delai de ("nom" + feuille) est dépassé)
- est-il possible d'avoir un envoie automatique sans ouverture du fichier excel mais en ayant Outlook d'ouvert ?
merci d'avance
re bonjour,
Mon problème n'est toujours pas résolu mais je viens vous faire part de mes avancées :
j'ai trouvé un code pour envoyer les mails (mais on est forcement à la fois l'expéditeur et le receveur):
Sub mail()
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 = "test vba "
Email_Send_To = "xxx@xxx.com"
Email_Body = "test 1"
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 Sub
Pour l'histoire de délai j'ai trouvé ce code (adapté à ma problématique) que j'ai "fusionné" avec le premier code:
Sub TesteDate()
'envoie un mail si la date est dépassée
Dim sSujet, sBody, sAdresseMail, sAdresseRetour As String 'chaines pour le sujet, corps, adresse d'envoi, adresse de retour
Dim duree As Integer 'nbre de jours entre aujourd'hui et la date à tester
Dim Lig_Deb, Lig_Fin As Integer 'ligne de début, de fin
Dim sDates_Col, sMails_Col As String 'colonnes qui contiennent les dates à tester et les adresses mail
Dim i As Integer
'initialisation des constantes de la macro :
Lig_Deb = 5 'dans ma feuille Excel, les dates à tester commencent en ligne 5
sDates_Col = "C" ' et elles sont en colonne C ( 3 ième colonne)et les adresses mail sont en colonne D à côté
'initialisation des données du mail envoyé :
sSujet = "test date old"
sBody = "test date " + vbNewLine + "test ligne 2" + vbNewLine
sAdresseRetour = "xxx@xxx.com"
'Ligne de fin =1ère cellule vide dans la colonne des dates
Lig_Fin = Val(Range(sDates_Col & CStr(Lig_Deb)).End(xlDown).Row)
' boucle de test dans la plage des dates (=> )
For i = Lig_Deb To Lig_Fin
Range(sDates_Col & CStr(i)).Select 'activer la cellule testée
duree = Now - ActiveCell.Value ' la date est dans la cellule active
If duree > 180 Then 'la date est dépassée
sAdresseMail = "xxx@xxx.com" 'l'adresse mail d'envoie
'MsgBox ("Envoi de courrier à " & sAdresseMail)
' envoyer le mail :
CDO_SendMail sSujet, sBody, sAdresseMail, sAdresseRetour
Else
'MsgBox ("La date n'est pas atteinte")
End If
Next i
End Subl'adaptation donne :
Sub mail()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
'envoie un mail si la date est dépassée
Dim duree As Integer 'nbre de jours entre aujourd'hui et la date à tester
Dim Lig_Deb, Lig_Fin As Integer 'ligne de début, de fin
Dim sDates_Col As String 'colonnes qui contiennent les dates à tester et les adresses mail
Dim i As Integer
Dim Mail_Object, Mail_Single As Variant
'initialisation des constantes de la macro :
Lig_Deb = 5 'dans ma feuille Excel, les dates à tester commencent en ligne 5
sDates_Col = "C" ' et elles sont en colonne C à I ( 3 ième colonne)et les adresses mail sont en colonne D à côté
'Ligne de fin =1ère cellule vide dans la colonne des dates
Lig_Fin = Val(Range(sDates_Col & CStr(Lig_Deb)).End(xlDown).Row)
' boucle de test dans la plage des dates (=> )
For i = Lig_Deb To Lig_Fin
Range(sDates_Col & CStr(i)).Select 'activer la cellule testée
duree = Now - ActiveCell.Value 'la date est dans la cellule active
If duree > 180 Then 'la date est dépassée
Email_Subject = "test date3 "
Email_Send_To = "xxxx@xxxx.com"
Email_Cc = "xxxx@xxx.com"
Email_Body = "test date " + vbNewLine + "test ligne 2" + vbNewLine
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 i
End Subce code fonctionne plus ou moins mais il y a plein de limites :
- probleme entre expérieur/receveur
- ne prend en compte que la colonne C
- il ne peut pas avoir de vide dans une ligne du tableau (ex : C1 et C3 rempli, C2 vide, la macro ne fonctionne pas ), le tableau est évolutif des lignes vont se rajouter
- je ne sais pas comment faire pour que l'objet du mail comporte "le delai de ("nom" + feuille) pour "trucx" est dépassé)
- faire plusieurs durée sur une macro ? 180 et 365 avec deux mails différents
Voila où j'en suis, si vous avez des idées je suis preneur
Merci et bonne journée