Macro VBA: mail auto avant échéance

Le 30/03/2016 à 10:08

Bonjour à tous,

Je fais appel à votre aide car la je bloque sur du code VBA.

Pour mon travail j'ai un tableau de suivi des visites médicales qui comprend plusieurs données (jour de la visite colonne C, heure colonne D, agent concerné colonne E, le mail du responsable colonne F et une colonne pour savoir si la convocation est réalisée en colonne G.

Mon sujet est le suivant: j'aimerai qu'automatiquement sans que le fichier excel soit ouvert, il envoie un mail trois jours avant la date de visite à l'adresse mail du responsable pour lui faire un rappel.

J'ai sur un forum trouvé un sujet qui correspond à ce problème mais le code ne fonctionne pas quand j'essaie de le mettre en forme pour mon tableau.

voici le code que j'ai actuellement dans mon fichier:

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 = "Visite médical"
sBody = "Votre agent doit passer sa visite médicale dans trois jours"
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 < 4 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 Sub

Lorsque je lance la macro via un bouton que j'ai créé cela m'indique l'erreur suivante:

"Erreur d'exécution 438 : Propriété ou méthode non gérée par cet objet"

Le débogage m'envoie sur la ligne :

.DSNOptions 14 'confirmation demandée dans tous les cas (voir ci-dessous avec 14 8 + 4 + 2)

Merci à vous pour votre aide car la je bloque vraiment sachant que je suis plutôt novice en VBA.

82test-vm.xlsm (24.92 Ko)
Le 30/03/2016 à 11:25

Bonjour,

à tester

pour recevoir un message qui indique que le mail est bien arrivé chez le destinataire

soit rajouter une signe =

 .DSNoptions=14

soit remplacer .dsnoptions par

.ReadReceiptRequested = True
Le 30/03/2016 à 11:42

Merci pour ta réponse rapide, j'ai rajouter le = sur le DSNOptions (en effet erreur d’inattention car logique), par contre nouvelle erreur "la valeur de configuration "SendUsing" est non valide".

Et le débogage m'affiche le ".Send" à la fin.

Le 30/03/2016 à 14:21

Alors j'ai modifié le code d'envoi du mail car j'avais une autre erreur. Du coup maintenant cela fonctionne, lorsque j'active la macro, il recherche dans la colonne C si il y a des dates <3 jours par rapport à aujourd'hui et dans ce cas envoie un mail au responsable.

Maintenant il me reste encore à automatiser cette macro. Mon fichier comprend un onglet par mois, le but est qu'automatiquement, sans ouvrir le fichier, la macro se déclenche une fois par jour afin de regarder sur chaque onglet les dates de visite qui sont dans trois jours et envoyer les mails si besoin.

Et pour ça je bloque aussi.

Le 13/08/2016 à 00:36

Bonjour,

Je ne connais presque pas les Macro VBA cependant je me suis lancé sur celle-ci.

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 du tout comment l'adapter à mon cas donc j'ai laissé cette partie tel quel.

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 adapté à mon cas sauf pour la position de l'adresse mail:

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 = 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 = "DLC à renouveler :"

sBody = "créer lot !" + vbNewLine + "envoyer lot à l’agrément FLI !!" + vbNewLine

sAdresseRetour = "xxxxxxxx@xxxxxxx.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 < 450 Then 'la date est dépassée

sAdresseMail = ActiveCell.Offset(0, 1).Value 'l'adresse mail est dans la colonne suivante offset (0,1)

' 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

Je vous remercie d'avance de vos lumières.

Lilette

Le 13/08/2016 à 12:54

Bonjour,

il vaut mieux ouvrir un nouveau fil pour une nouvelle demande.

je pense que le message d'erreur provient du fait qu'il ne trouve pas les librairies CDO sur ton ordinateur.

voir ici

https://support.microsoft.com/fr-be/kb/171440

outlook est-il installé ?

Le 19/08/2016 à 07:37

Ok, merci.

Je vais en créer une.

Lilette

Rechercher des sujets similaires à "macro vba mail auto echeance"