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
| Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$F$1" Then Exit Sub
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = Target.Value
'.CC = " mail@mail.com; mail@mail.com "
'.BCC = " mail@mail.com "
.Subject = "mouvements clients"
.body = "Bonjour," & Chr(13) & Chr(13) & "Veuillez trouver, ci-joint, le fichier des jours
.." & _
Chr(13) & Chr(13) & "Cordialement." & Chr(13) & Chr(13) & "blabla"
Feuille = Application.Index([B:B], Application.Match(Target.Value, [A:A], 0))
Sheets(Feuille).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "c:\temp\temp.xls", FileFormat:=xlExcel8
Application.DisplayAlerts = True
.Attachments.Add ActiveWorkbook.FullName
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Partager