Bonjour Kelly,
Voici les instructions pour créer la tache planifiée, et les codes
j'ai également tous mit dans le fichier joint
attention pour ceux qui ouvriront le fichier si la date du jour est le 1er du mois
la macro "SendRangeByMail" va s'exécuter, mais c'est en .Display
'Pour exécuter le Planificateur de tâches à l'aide de l'interface Windows
'Cliquez sur le bouton Démarrer.
'Cliquez sur le Panneau de configuration.
'Cliquez sur Système et Maintenance.
'Cliquez sur Outils d'administration.
'Double-cliquez sur Planificateur de tâches.
'Démarrer le planificateur de tâches - TechN
'Tache:
'ouverture du fichier KELLY-SendRangeByMail.xlsm
'effectuer la tache tous les 1er du mois
sur la page ThisWorkbook
Private Sub Workbook_Open()
If Day(Date) = 1 Then SendRangeByMail
End Sub
sur la page Module1
Sub SendRangeByMail()
Dim rngeSend As Range
With Application
On Error Resume Next
Set rngeSend = Sheets("mail").Range(Range("A1").CurrentRegion.Address)
If rngeSend Is Nothing Then Exit Sub
On Error GoTo 0
.ActiveWorkbook.PublishObjects.Add(4, "C:\Temp\XLRange.htm", rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True
Call PrepareOutlookMail("C:\Temp\XLRange.htm")
Kill "C:\Temp\XLRange.htm"
End With
End Sub
Sub PrepareOutlookMail(sFileName)
Dim appOutlook As Outlook.Application
Dim oMail As Outlook.MailItem
Set appOutlook = CreateObject("Outlook.Application")
If Not (appOutlook Is Nothing) Then
Set oMail = appOutlook.CreateItem(olMailItem)
With oMail
.To = "MonAdresse@Courriel"
.Subject = "Relances à effectuer"
.HTMLBody = ReadFile(sFileName)
.Display
' .Send
End With
Set oMail = Nothing
Set appOutlook = Nothing
End If
End Sub
Public Function ReadFile(sFileName) As String
Dim fso As Object, fFile As Object
Dim sTemp As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fFile = fso.OpenTextFile(sFileName, 1, False)
sTemp = fFile.ReadAll
fFile.Close
Set fFile = Nothing
ReadFile = sTemp
End Function