Envoi de mail automatique quand la date est atteinte
Bonjour,
Je ne connais presque pas les Macro VBA cependant je me suis lancée.
J'ai un fichier excel qui contient des dates de DLC sur la colonne C, j'aimerai être alerté 15 mois avant la date arrivé à échéance.
L'adresse mail à envoyer sera toujours la même mais je ne sais pas comment adapter le code que j'ai trouvé à mon cas. SVP, pouvez-vous m'aiguiller comment le faire?
En exécutant la macro VBA, j'ai reçu une message d'erreur, SVP pouvez-vous m'aider?
Erreur 429
Set iMsg = CreateObject("CDO.Message")
Voici le code VBA que j'ai utilisé:
Option Explicit
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 Long '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 = 2 'dans ma feuille Excel, les dates à tester commencent en ligne 2
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 = "Agréement lot FLI"
sBody = "Enoyer le nouveau lot dès qu’il est disponible"
sAdresseRetour = "***@***"
'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 < 450 Then 'la date est dépassée
sAdresseMail = ActiveCell.Offset(0, 3).Value 'l'adresse mail est dans la colonne suivante offset (0,1)
'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 Sub
Sub CDO_SendMail(ByVal sSujet As String, ByVal sBody As String, ByVal sAdresseMail As String, ByVal sAdresseRetour)
'MARCHE IMPEC, sans demande de confirmation ;-)))))
'on peut préciser : le sujet, le corps , l'adresse mail, l'adresse de retour
Dim iMsg As Object
Dim iConf As Object
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
With iMsg
.Configuration = iConf
.To = sAdresseMail
.Sender = sAdresseRetour 'adresse de l'expéditeur pour le rapport envoyé
.From = sAdresseRetour 'adresse de l'expéditeur du mail
.ReplyTo = sAdresseRetour 'adresse à laquelle sera envoyée la réponse
.CC = ""
.BCC = ""
.Subject = sSujet 'sujet du message
.TextBody = sBody 'corps du message
'.AddAttachment Fichier 'fichier joint
.DSNOptions 14 'confirmation demandée dans tous les cas (voir ci-dessous avec 14 8 + 4 + 2)
' (0=pas réponse ; 2=rapport si échec ; 4=rapport si réussi ; 8=rapport si délai)
' pour demander des confirmations de réception ou d'envoi :
.Fields("urn:schemas:mailheader:return-receipt-to") = sAdresseRetour
.Fields("urn:schemas:mailheader:disposition-notification-to") = sAdresseRetour
' Update fields
.Fields.Update
' envoi
.Send
End With
End SubJe vous remercie d'avance de vos lumières.
Lilette
Bonjour Lilette
Lilette a écrit :Je ne connais presque pas les Macro VBA cependant je me suis lancée.
C'est bien
Lilette a écrit :J'ai un fichier excel qui contient des dates de DLC sur la colonne C, j'aimerai être alerté 15 mois avant la date arrivé à échéance.
Attention, le mail mail ne pourra pas être envoyé "automatiquement" si le fichier n'est pas ouvert
Pour ce qui concerne l'envoi via CDO, regarde à cette adresse http://www.rondebruin.nl/win/s1/cdo.htm
A+
Merci!
Je vais lire le lien et essayer de déchiffrer
Une fois que j'aurai fait le nouvel essaie je vais vous écrire.
Lilette