Envoi de mail automatique via OUTLOOK

Bonjour tlm,

J'aurai besoin d'un coup de pouce pour réaliser une macro afin d'envoyer un mail automatique si la date buttoirs est dépassé via outlook.

La problématique est je sais pas si il est possible que l'envoi du mail se fasse sans avoir à ouvrir le fichier Excel, et biensur qu'un mail ne soit pas envoyé tout les jours mais uniquement à une ou de date, par exemple J-14 et J-1.

Mes connaissances en VBA sont quasi nul, pour pas dire 0

Ci-joint mon tableau, avec les machine concerné, la date de la derniere vérification (VGP), le nombre de jours restant avant la prochaine et enfin la derniere colonnes avec la date buttoirs.

Merci d'avance pour votre aide.

Clément.

82vgp.xlsm (20.74 Ko)

Bonjour,

quelques recherches sur le net j'ai trouvé ce code, j'ai modifié mon tableau pour qu'il colle avec le code ci dessous mais je n'arrive pas a trouver le problème.

SI quelqu'un pourrait m’aiguiller un peu je suis preneur MERCI !!

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 = 5 'dans ma feuille Excel, les dates à tester commencent en ligne 2

sDates_Col = "G" ' et elles sont en colonne ( 7 ième colonne)et les adresses mail sont en colonne H à côté

'initialisation des données du mail envoyé :

sSujet = "Attention VGP "

sBody = "Test test test" + vbNewLine + "Test test test" + vbNewLine

sAdresseRetour = "monmail@gmail.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 > 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

157vgp.xlsm (29.20 Ko)
Rechercher des sujets similaires à "envoi mail automatique via outlook"