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
| Option Explicit
Sub Envoi_Mail()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Dim texte As String
Dim i As String
Dim Nomfic As String, spath As String, Nomfic1 As String, spath1 As String, spath2 As String, nomfic2 As String, spath3 As String, nomfic3 As String
spath = Environ("USERPROFILE")
spath1 = Environ("USERPROFILE")
spath2 = Environ("USERPROFILE")
spath3 = Environ("USERPROFILE")
spath = spath & "\bureau\SGIIOC+\"
spath1 = spath1 & "\bureau\SGIIOC+\"
spath2 = spath2 & "\bureau\SGIIOC+\"
spath3 = spath3 & "\bureau\SGIIOC+\"
Nomfic = Sheets("parametre").Range("A107").Value
Nomfic1 = Sheets("parametre").Range("A108").Value
nomfic2 = Sheets("parametre").Range("A109").Value
nomfic3 = Sheets("parametre").Range("A1010").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
i = Range("C35").Value
texte = texte & Sheets("PF").Range("C74").Value & " le, " & Date & vbCrLf & vbCrLf
texte = texte & "A" & vbCrLf
texte = texte & Sheets("parametre").Range("AO2").Value & vbCrLf
texte = texte & Range("C32").Value & vbCrLf
texte = texte & Sheets("parametre").Range("U98").Value & vbCrLf & vbCrLf & vbCrLf
On Error Resume Next
With OutMail
.To = Range("C35").Value
.CC = ""
.BCC = ""
.Subject = "Bienvenue dans votre Banque"
.Body = texte
.Attachments.Add spath & Nomfic
.Attachments.Add spath1 & Nomfic1
.Attachments.Add spath2 & nomfic2
.Attachments.Add spath3 & nomfic3
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\users/benzoplus/desktop/lm bad.pdf")
'Ex:.Attachments.Add ("C:\users/benzoplus/desktop/lm bad.pdf")
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Partager