Discussion :

[Tomapaco]

Bonjour,

J'ai trouvé sur le net une macro qui permet d'envoyer automatiquement par mail (Outlook) une copie d'un fichier Excel.

Cependant dans mon cas précis le fichier utilisé sera un "template" avec une extension .xltm et lorsque la macro est lancée, je voudrais que le fichier en copie du mail soit au format .xlsm.

Quelqu'un peut me dire ce qui doit être change au niveau du code ci-dessous?

Merci d'avance.

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
Sub Mail_workbook_Outlook_2()
'Working in Excel 2000-2016
 
    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 = "email"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    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

[Tomapaco]

Il semble que si je ne prends pas en compte le "FileExtStr" au moment où le fichier est sauvé et effacé et que au niveau du nom du fichier je mets .xlsm à la fin cela marche.

Mais comme je ne comprends pas le code suivant je ne sais pas si ne pas le prendre en compte pourrait poser problème?

Code :

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

FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

Du coup le code final serait ceci:

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
Sub Mail_workbook_Outlook_2()
'Working in Excel 2000-2016
 
    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" & ".xlsm")
    '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 = "email"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    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

Quelqu'un sait si ça peut poser problème? Une autre façon plus fiable?

[mathspountz]

N'aurais-tu pas un problème de parenthèse Ligne 21 ?

Code :

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

TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss" & ".xlsm")

Devrait être

Code :

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

TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsm"

[Invité]

Bonjour,
je ne comprends pas la question de fichier xltm? j'imagine que tu ouvre ton ficher xltm au lieux de faire un add modèle!

Code :

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

1
2
3
4
5
6
7
8
9
Dim wb As Workbook
Set wb = Workbooks.Add("c:\Modèle.xltm")
 
'TempFileName1 = "Copy of " & split( wb1.Name,".")(0)  & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".xlsm"
'TempFileName2 = Format(Now, """" & Environ$("temp") & "\Copy of  [Modèle]"" dd-mmm-yy h-mm-ss"".xlsm""")
'TempFileName2= Replace(TempFileName2, "[Modèle]", Split(wb.Name & ".", ".")(0))
'TempFileName3 = Format(Now, """" & Environ$("temp") & "\Copy of  " & Split(wb.Name & ".", ".")(0)  &""" dd-mmm-yy h-mm-ss"".xlsm""")
wb.SaveAs  "Copy of  Modèle " & Format(Now, "dd-mmm-yy h-mm-ss" & ".xlsm"), xlOpenXMLWorkbookMacroEnabled 'on le connais le nom du fichier? non?
wb.Close False

[Tomapaco]

Bonjour rdurupt et mathspountz,

Je ré-explique mon problème:
1. J'ai crée un fichier .xlsm contenant une macro qui envoie une copie du fichier par mail (Outlook) une fois complété (il sear utilisé par d'autres personnes).
2. Afin de rendre le fichier disponible à mes collègues de tavail, notre service IT le place sur le réseau et les gens peuvent l'utiliser en tant que "template" dans Excel.
3. Le problème est que peu importe si le fichier est enregistré en tant que .xlsm ou .xltm, au moment ou quelqu'un l'ouvre via le menu "templates" il se transforme automatiquement en .xtlm.
4. Mon code marchait tant que le fichier était au format .xlsm mais en ouvrant ce même fichier en tant que template, la copie du fichier qui est générée dans l'email n'est pas reconnue par Excel car le nom n'est pas bon:
Exexples:
- si j'utilise le fichier .xlsm : le nom de fichier généré serait test.xlsm
- la mêeme chose en l'ouvrant via "templates": le nom généré serait test.test

Je ne comprends pas pourquoi le fait de passer par le template cause ce problème ni ce que je dois changer au niveau du code pour corriger ceci.

En attendant j'ai "contourné" le problème en ignorant une partie du code original (en rouge ci-dessous) et rajouté ce qui est orange.


Voici le vrai code que j'utilise actuellement:

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
Sub Mail_workbook_Outlook()
    
    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


    TempFilePath = Environ$("temp") & "\"
    TempFileName = Format(Now, "yyyy-mm-dd") & "_" & Range("G9") & "_" & "ORER.xlsm"
    '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 = "xxx"
        .CC = ""
        .BCC = ""
        .Subject = "ORER_" & Range("g9") & "_" & Range("g7")
        .Body = ""
        .Attachments.Add TempFilePath & TempFileName '& FileExtStr
        .Display

    End With
    On Error GoTo 0

    Kill TempFilePath & TempFileName '& FileExtStr 

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With


End Sub

[Tomapaco]

Pour résumer donc, cette ligne de code fait en sorte que:

Code :

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

FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

1. Le fichier en copie du mail a la bonne extension si le fichier original est .xlsm
2. Le fichier en copie du mail a pour extension son nom par défaut (vu que la macro lui donne un autre nom via "TempFileName") si le fichier original est .xtlm

Quelqu'un sait la raison?