Bruno67
XLDnaute Nouveau
Bonjour,
Dans mon fichier excel, j'ai un bouton qui permet de joindre des fichiers (pdf, doc,...). Cette macro crée une feuille avec le fichier joint et lorsqu'on clique 2 fois sur ce fichier, il s'ouvre.
Le problème est lorsque j'envoi le classeur par courriel, les feuilles sont bien présentent mais il n'est pas possible d'ouvir les fichiers joints.
Je suis débutant en VBA....
voici le code pour le bouton d'envoi.
je pense qu'il y a un rapport avec .Attachments.Add
Merci beaucoup de votre aide!
Dans mon fichier excel, j'ai un bouton qui permet de joindre des fichiers (pdf, doc,...). Cette macro crée une feuille avec le fichier joint et lorsqu'on clique 2 fois sur ce fichier, il s'ouvre.
Le problème est lorsque j'envoi le classeur par courriel, les feuilles sont bien présentent mais il n'est pas possible d'ouvir les fichiers joints.
Je suis débutant en VBA....
voici le code pour le bouton d'envoi.
je pense qu'il y a un rapport avec .Attachments.Add
Merci beaucoup de votre aide!
Code:
Sub Mail_workbook_Outlook_2()
'Working in Excel 2000-2016
'Mail a copy of the ActiveWorkbook with another file name
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
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 = "" & 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
.Attachments.Add ActiveWorkbook.Path & "\" & nomfic
'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