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 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 = 4 '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 = "Attestation d'assurance:" sBody = "Bonjour," + vbNewLine + "Pouvez-vous nous transmettre votre attestation d'assurance à jour afin de mettre notre dossier administratif sous-traitant." + vbNewLine + "En vous remerciant." + vbNewLine + "Cordialement," + vbNewLine sAdresseRetour = "-------------------@hotmail.fr" '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 > 0 Then 'la date est dépassée sAdresseMail = ActiveCell.Offset(0, 1).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 Sub
EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI Merci d'y penser dans tes prochains messages. |