1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| Private Sub Workbook_Open()
' !!! Pour l'envoi par CDO, il faut référencer "Microsoft CDO for Windows 2000 Library"
Dim Ws As Worksheet 'Variable pour affecter le nom de ta feuille
Dim DerLig As Long 'Variable pour déterminer la dernière ligne remplie de la colonne K
Dim r As Long 'Variable pour la boucle
Dim Mbody As String 'Variable pour récupérer le texte à mettre dans le corps du message
Dim Cdo_Message As Object 'Variable pour la procédure d'envoi de mail
Set Ws = Sheets("feuil1") 'Remplace ici le nom de ta feuille
DerLig = Ws.Cells(Columns(11).Cells.Count, 11).End(xlUp).Row 'récupère le N° de la dernière ligne remplie de la colonne K
For r = 9 To DerLig 'Boucle sur toutes les lignes comprisent entre la 9 et la dernière remplie
If Ws.Cells(r, 11) <= Date Then 'Vérifie si le contenu de la cellule est <= que la date du jour
Mbody = Mbody & "échéance Mr X " & Ws.Cells(r, 3) 'Adapte le texte avec l'intitulé du produit périmé, adapter éventuellement la mise en forme avec des retours chariots
End If
Next r
Set Cdo_Message = CreateObject("CDO.Message")
Set Cdo_Message.Configuration = GetSMTPServerConfig()
With Cdo_Message
.To = "louispaster90" & Chr(64) & "gmail.com" 'Adapter ici l'adresse du destinataire
.From = "xxxxx" & Chr(64) & "gmail.com" 'Adapter ici l'adresse de l'envoyeur, possibilité de passer ça en variable
.Subject = "Le Sujet" 'Adapter ici le sujet du mail, idem possible de la faire en variable
.HTMLBody = Mbody & Cdo_Message.HTMLBody 'Récupère le texte pour le corps du message
'.AddAttachment ("c:cheminfichier.ext") 'Pour éventuellement joindre un fichier
'.Cc = "LeCC" & Chr(64) & "hotmail.com" 'Pour mettre quelqu'un en CC
.send 'send
End With
Set Cdo_Message = Nothing
End Sub |
Partager