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 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
| Sub MailAutomatique()
'Objects used in macro
'Outlook objects
Dim objApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strHtml As String
Dim Lecteur As Object
Dim nOm As String
Set Lecteur = CreateObject("Scripting.FileSystemObject")
Set olApp = GetObject("", "Outlook.application")
Dim olExplorer As Outlook.Explorer
Set objMail = olApp.CreateItem(olMailItem)
'Emails details
With objMail
.Display 'Open the Outlook Window
.Subject = "Indicateurs mensuels de qualité et productivité du CRC " & Format(DateAdd("m", -1, Date), "mmmm") & " " & Year(Date) 'Email's subject
.To = "ombeline.malone@ingdirect.fr" 'Email's recipient
End With
'is the drive letter Z or V ?
If Lecteur.Driveexists("V") Then
nOm = "V"
ElseIf Lecteur.Driveexists("Z") Then
nOm = "Z"
End If
'Export charts as pictures
With Feuil20
.ChartObjects("Graph1").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\KPIAppels.jpg", "JPG"
.ChartObjects("Graph2").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\KPIEmails.jpg", "JPG"
.ChartObjects("Graph3").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\DMT.jpg", "JPG"
.ChartObjects("Graph4").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\FTEProd.jpg", "JPG"
.ChartObjects("Graph5").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\QualiteAppels.jpg", "JPG"
.ChartObjects("Graph6").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\QualiteEmails.jpg", "JPG"
.ChartObjects("Graph7").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\HomogEval.jpg", "JPG"
.ChartObjects("Graph8").Chart.Export nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\PartCCObj.jpg", "JPG"
End With
'Emails format
strHtml = "Bonjour, <BR><BR>"
strHtml = strHtml & "Veuillez trouver ci-dessous les indicateurs mensuels concernant la qualité et la productivité du CRC pour " & Format(DateAdd("m", -1, Date), "mmmm") & " " & Year(Date) & "." & "<BR>"
strHtml = strHtml & "Nous restons à votre disposition pour toute information complémentaire."
strHtml = strHtml & "<BR><BR><BR>"
strHtml = strHtml & "<b><u><span style="" font-size: 28""><center> INDICATEURS DE PRODUCTIVITE CRC </center></TD></span></u></b>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:KPIAppels.jpg'></center>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:KPIEmails.jpg'></center>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:DMT.jpg'></center>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:FTEProd.jpg'></center>" & "<BR><BR><BR><BR><BR><BR><BR><BR>"
strHtml = strHtml & "<b><u><span style=""font-size: 28 ""><center> INDICATEURS DE QUALITE CRC </center></span></u></b>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:QualiteAppels.jpg'></center>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:QualiteEmails.jpg'></center>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:HomogEval.jpg'></center>" & "<BR><BR>"
strHtml = strHtml & "<center><img src='cid:PartCCObj.jpg'></center>" & "<BR><BR>"
'Attach pictures in the email and copy it in the email's body (for each picture)
With objMail.Attachments
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\KPIAppels.jpg"
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\KPIEmails.jpg"
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\DMT.jpg"
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\FTEProd.jpg"
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\QualiteAppels.jpg"
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\QualiteEmails.jpg"
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\HomogEval.jpg"
.Add nOm & ":\WFM\6. NEW REPORTS\MENSUEL\QUALIPROD CRC\QUALIPROD 2013\img qualiprod\PartCCObj.jpg"
End With
objMail.HTMLBody = strHtml
objMail.BodyFormat = olFormatHTML
End Sub |
Partager