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 76 77 78 79 80 81
| Sub EnvoiMail()
Const Img_temp As String = "N:\Application Data\Microsoft\Signatures\Médérick MONTOUT_fichiers\image002.jpg"
Dim OutlookApp As Object
Dim Mail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set Mail = OutlookApp.CreateItem(0)
Set mapiecejte = Mail.Attachments
With Mail
.To = "nicolas.carpentier@socgen.com" & ";" & "herve.delaunay@socgen.com"
.CC = "mes copies"
.Subject = "Demande d'habilitations"
.HTMLBody = "Bonjour," & vbCrLf & vbCrLf & "Merci de bien vouloir créer le profil suivant" & GetBoiler("N:\Application Data\Microsoft\Signatures\Médérick MONTOUT.htm")
.display
End With
Call Plage_Mail
Application.Wait (Now + TimeValue("0:00:01"))
AppActivate Objet_Mail & " - Message", 0 ' Active Outlook
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "^v", True ' coller
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%v", True ' Envoi du message
Application.CutCopyMode = False
Set Applic_Outlook = Nothing
Set Mail = Nothing
Set OutlookApp = Nothing
If Err.Number <> 0 Then
MsgBox Err.Description, 16, "Erreur"
MsgBox "le mail n'a pas pu être envoyé !", 16, "Information"
Else
MsgBox "Le mail a été bien envoyé !", 64, "Information"
End If
On Error GoTo 0
End Sub
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile("N:\Application Data\Microsoft\Signatures\Médérick MONTOUT.htm").OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Sub Plage_Mail()
Call Image_Temporaire
End Sub
Sub Image_Temporaire(Optional dummy As Byte)
Dim cellule_corp As Range
Dim image_chart As ChartObject
On Error Resume Next
For Each Image In ActiveSheet.Charts
Image.Delete
Next
On Error GoTo 0
'à adapter ==> il s'agit du champ comprtant la signature
Set cellule_corp = Range("corps_5")
cellule_corp.CopyPicture xlScreen, xlBitmap
With cellule_corp
Set image_chart = ActiveSheet.ChartObjects.Add( _
.Left, .Top, .Width + 5, .Height + 5)
End With
With image_chart.Chart
.Paste
.Export Filename:=Img_temp
End With
image_chart.Delete
Set image_chart = Nothing
Set cellule_corp = Nothing
End Sub |
Partager