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
| Option Explicit
Sub Mail_Visa()
' 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 Dossier As String, Exercice As String
Dossier = "C:\Username\Desktop"
Exercice = Dossier & "\VISA " & Format(Date, "yyyy")
If Dir(Exercice, vbDirectory) = "" Then MkDir Exercice
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
texte = texte & "Bonjour à tous" & vbCrLf & vbCrLf
texte = texte & "Merci de trouver en fichier joint les demandes de dépassements exprimées par nos clients" & vbCrLf & vbCrLf
texte = texte & "Bonne réception" & vbCrLf & vbCrLf
On Error Resume Next
With OutMail
.To = Sheets("parametre").Range("23").Value
.Cc = Sheets("parametre").Range("24").Value
.BCC = ""
.Subject = "Demande de visa"
.Body = texte
' You can add other files by uncommenting the following line.
.Attachments.Add Exercice & "\" & Sheets("PARAMETRE").Range("R1")
.Send
End With
On Error GoTo 0
' Effacer les variable objet
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Sub Mail_Visa_DR()
' 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 Dossier As String, Exercice As String
Dossier = "C:\Username\Desktop"
Exercice = Dossier & "\VISA " & Format(Date, "yyyy")
If Dir(Exercice, vbDirectory) = "" Then MkDir Exercice
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
texte = texte & "Bonjour à tous" & vbCrLf & vbCrLf
texte = texte & "Merci de trouver en fichier joint les demandes de dépassements exprimées par nos clients" & vbCrLf & vbCrLf
texte = texte & "Bonne réception" & vbCrLf & vbCrLf
On Error Resume Next
With OutMail
.To = Sheets("parametre").Range("26").Value
.Cc = Sheets("parametre").Range("24").Value
.BCC = ""
.Subject = "Demande de visa"
.Body = texte
' You can add other files by uncommenting the following line.
.Attachments.Add Filename:=Exercice & "\" & Sheets("PARAMETRE").Range("R1")
.Send
End With
On Error GoTo 0
' Effacer les variable objet
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Partager