Discussion :

[moss67]

Bonjour,

je suis un débutant dans VBA et j'ai crée un bouton qui permet l'envoi d'un formulaire par mail. La seul chose c'est qu'il faut absolument enregistrer le fichier avant de l'envoyé.
Y a t'il un moyen de le faire automatiquement dans le script?

Merci beaucoup de votre aide!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'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 OutApp As Object
    Dim OutMail As Object
 
    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, ci-joint la demande informatique."
        .Attachments.Add ActiveWorkbook.FullName
        '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
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

[moss67]

J'ai trouvé, voici le bon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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