Envoi mail automatique

FaruSZ

XLDnaute Occasionnel
Bonjour,
Comment faire pour envoyer un mail automatique ( sans utiliser des boutons) pour informer le personnel sur la fin de validité de quelques éléments dans une base de données?
Jusqu'à présent j'ai réussi a écrire un code dans un module qui me permet d'afficher un message d'alerte quand la date de validité approche et ceci a l'ouverture de mon fichier Excel comme suit:

'Afficher date fin validité des formations internes
Sub AlertesDatesFormations()
Dim Sh As Worksheet, Chaine As String, Lig As Integer, Alerte
Lig = 14 ' car les dates de validité se trouvent en ligne 14
For Each Sh In ActiveWorkbook.Sheets
If Sh.Range("A10") = "Formation interne" Then 'Formation concernée
Col = 2 ' car la premiére date de validité en en colonne B
While Sh.Cells(Lig - 4, Col) <> "" ' on regarde toutes les formations dans la colonne A10 (14-4=10)
If Sh.Cells(Lig, Col) <> "" And Sh.Cells(Lig, Col) < Date + 60 Then ' si formation et date
' on enrichit la chaine avec nom-date-formation
Chaine = Chaine & Sh.Name & vbTab & " Date: " & Sh.Cells(Lig, Col) & " " & Sh.Cells(Lig - 1, Col) & vbCrLf
End If
Col = Col + 1
Wend
If Chaine <> "" Then Chaine = Chaine & vbCrLf
End If
Next Sh
If Chaine <> "" Then Alerte = MsgBox(Chaine, , "Alertes sur les dates de validitéformations.")
End Sub


je veux ajouter l'envoi du mail a l'intérieur de ce code
 

danielco

XLDnaute Accro
La première ligne doit être e, tête d'un module :

VB:
Dim Desti As String, Objet As String, Corps As String, olApp As Object
Sub AlertesDatesFormations()
Dim Sh As Worksheet, Chaine As String, Lig As Integer, Alerte
  Set olApp = CreateObject("Outlook.application")
Lig = 14 ' car les dates de validité se trouvent en ligne 14
For Each Sh In ActiveWorkbook.Sheets
If Sh.Range("A10") = "Formation interne" Then 'Formation concernée
Col = 2 ' car la premiére date de validité en en colonne B
While Sh.Cells(Lig - 4, Col) <> "" ' on regarde toutes les formations dans la colonne A10 (14-4=10)
If Sh.Cells(Lig, Col) <> "" And Sh.Cells(Lig, Col) < Date + 60 Then ' si formation et date
' on enrichit la chaine avec nom-date-formation
Chaine = Chaine & Sh.Name & vbTab & " Date: " & Sh.Cells(Lig, Col) & " " & Sh.Cells(Lig - 1, Col) & vbCrLf
End If
Col = Col + 1
Wend
If Chaine <> "" Then Chaine = Chaine & vbCrLf
End If
Next Sh
If Chaine <> "" Then
  Alerte = MsgBox(Chaine, , "Alertes sur les dates de validitéformations.")
  Desti = "xxx@xx.com"
  Objet = "OBJET DU MESSSAGE"
  Corps = "CORPS DU MESSAGE"
  EnvoiMail Desti, Objet, Corps
End If
End Sub

Sub EnvoiMail(Desti As String, Objet As String, Corps As String)
  Dim M As Object
  Set M = olApp.CreateItem(olMailItem)
  With M
    .Subject = Objet
    .Body = Corps
    .Recipients.Add Desti
    .Send
  End With
End Sub

Daniel
 

FaruSZ

XLDnaute Occasionnel
La première ligne doit être e, tête d'un module :

VB:
Dim Desti As String, Objet As String, Corps As String, olApp As Object
Sub AlertesDatesFormations()
Dim Sh As Worksheet, Chaine As String, Lig As Integer, Alerte
  Set olApp = CreateObject("Outlook.application")
Lig = 14 ' car les dates de validité se trouvent en ligne 14
For Each Sh In ActiveWorkbook.Sheets
If Sh.Range("A10") = "Formation interne" Then 'Formation concernée
Col = 2 ' car la premiére date de validité en en colonne B
While Sh.Cells(Lig - 4, Col) <> "" ' on regarde toutes les formations dans la colonne A10 (14-4=10)
If Sh.Cells(Lig, Col) <> "" And Sh.Cells(Lig, Col) < Date + 60 Then ' si formation et date
' on enrichit la chaine avec nom-date-formation
Chaine = Chaine & Sh.Name & vbTab & " Date: " & Sh.Cells(Lig, Col) & " " & Sh.Cells(Lig - 1, Col) & vbCrLf
End If
Col = Col + 1
Wend
If Chaine <> "" Then Chaine = Chaine & vbCrLf
End If
Next Sh
If Chaine <> "" Then
  Alerte = MsgBox(Chaine, , "Alertes sur les dates de validitéformations.")
  Desti = "xxx@xx.com"
  Objet = "OBJET DU MESSSAGE"
  Corps = "CORPS DU MESSAGE"
  EnvoiMail Desti, Objet, Corps
End If
End Sub

Sub EnvoiMail(Desti As String, Objet As String, Corps As String)
  Dim M As Object
  Set M = olApp.CreateItem(olMailItem)
  With M
    .Subject = Objet
    .Body = Corps
    .Recipients.Add Desti
    .Send
  End With
End Sub

Daniel
Merci pour le code je l'ai copié dans un module mais j'ai juste l'affichage du msg d'alerte en ouvrant le fichier Excel. :/
 

Discussions similaires

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa