VBA envoi mail sans enregistrer

J'ai trouvé, voici le bon code:
Code:
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
Sub Mail_workbook_Outlook_2()
'Working in Excel 2000-2016
'Mail a copy of the ActiveWorkbook with another file name
'For Tips see: <a href="http://www.rondebruin.nl/win/winmail/Outlook/tips.htm" target="_blank">http://www.rondebruin.nl/win/winmail/Outlook/tips.htm</a>
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set wb1 = ActiveWorkbook
 
    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
 
    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .to = "phti@ia.ca"
        .CC = ""
        .BCC = ""
        .Subject = Range("B5").Value
        .Body = "Bonjour, voici une demande informatique."
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
        MsgBox "Votre demande a bien été transmise."
    End With
    On Error GoTo 0
 
    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr
 
    Set OutMail = Nothing
    Set OutApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub