Erreur envoi fichier avec code VBA
Bonjour,
J'aurais besoin de votre aide car j'ai un fichier Excel avec plusieurs onglets, je clique sur un bouton qui permet de générer un mail avec en pièce jointe un seul onglet sélectionné (voir code ci-après). De mon PC, tout fonctionne parfaitement mais dès que je passe sur un autre PC, ça se complique et je n'y comprends pas grand chose... (le message qui s'affiche d'un PC autre que le mien est le suivant : "Impossible d'exécuter la macro "C:\Users\XXXX(autre utilisateur que moi)\AppData...etc. Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivées".
Le problème étant que je ne veux pas qu'il cherche une macro sur le PC sur lequel est ouvert l'Excel...
Merci par avance pour votre aide !
Code actuel :
Public Sub New_Book()
Dim ws As Worksheet, strPath As String, strFilename As String
strPath = ThisWorkbook.Path & Application.PathSeparator
Set ws = ThisWorkbook.Worksheets("Base clients")
Set ws2 = ThisWorkbook.Worksheets("1. Fiche")
strFilename = strPath & ws2.Cells(4, 6).Value & " - Fiche d'onboarding client.xlsm"
ws.Copy before:=Workbooks.Add.Worksheets(1)
ActiveWorkbook.SaveAs strFilename, 52
Dim MonOutlook As Object
Dim MonMessage As Object
Dim MonDossier As String
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
ActiveWorkbook.Save
MonMessage.To = ""
MonMessage.Subject = "Fiche client"
MonMessage.body = "Cher client," & _
Chr(13) & Chr(13) & "Vous trouverez ci-joint votre fiche à compléter." & _
Chr(13) & Chr(13) & "Bien cordialement,"
MonMessage.Attachments.Add ActiveWorkbook.FullName
MonMessage.display
Set MonOutlook = Nothing
End Sub
Bonjour,
Je ne comprends pas trop ton erreur d'exécution.
Essaie ainsi :
Option Explicit
Public Sub New_Book()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim strPath As String, strFilename As String
Dim MonOutlook As Object, MonMessage As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With ActiveWorkbook
strPath = .Path & Application.PathSeparator
Set ws = .Worksheets("Base clients")
Set ws2 = .Worksheets("1. Fiche")
End With
strFilename = strPath & ws2.Cells(4, 6).Value & " - Fiche d'onboarding client.xlsm"
ws.Copy
Set wb = ActiveWorkbook
Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)
With wb
.SaveAs strFilename, 52
On Error Resume Next
With MonMessage
.To = ""
.Subject = "Fiche client"
.body = "Cher client," & _
Chr(13) & Chr(13) & "Vous trouverez ci-joint votre fiche ? compl?ter." & _
Chr(13) & Chr(13) & "Bien cordialement."
.Attachments.Add wb.FullName
.Display 'ou .Send
End With
On Error GoTo 0
.Close False
End With
Kill strFilename
Application.EnableEvents = True
Set MonOutlook = Nothing
Set MonMessage = Nothing
End Sub
Bonjour Jean-Eric et merci beaucoup pour ton aide (à nouveau)
Ton code semble résoudre une partie du problème en revanche, une fois que le mail avec la fiche Excel en pièce-jointe est généré, quand la personne recevant ce mail ouvre le fichier Excel et qu'elle clique sur un bouton censé ouvrir
un formulaire, ce dernier ne s'ouvre pas et le message d'erreur suivant apparaît (voir PJ)
Bonjour,
Je ne comprends pas trop ton erreur d'exécution.
Essaie ainsi :
Option Explicit Public Sub New_Book() Dim wb As Workbook Dim ws As Worksheet, ws2 As Worksheet Dim strPath As String, strFilename As String Dim MonOutlook As Object, MonMessage As Object With Application .ScreenUpdating = False .EnableEvents = False End With With ActiveWorkbook strPath = .Path & Application.PathSeparator Set ws = .Worksheets("Base clients") Set ws2 = .Worksheets("1. Fiche") End With strFilename = strPath & ws2.Cells(4, 6).Value & " - Fiche d'onboarding client.xlsm" ws.Copy Set wb = ActiveWorkbook Set MonOutlook = CreateObject("Outlook.Application") Set MonMessage = MonOutlook.CreateItem(0) With wb .SaveAs strFilename, 52 On Error Resume Next With MonMessage .To = "" .Subject = "Fiche client" .body = "Cher client," & _ Chr(13) & Chr(13) & "Vous trouverez ci-joint votre fiche ? compl?ter." & _ Chr(13) & Chr(13) & "Bien cordialement." .Attachments.Add wb.FullName .Display 'ou .Send End With On Error GoTo 0 .Close False End With Kill strFilename Application.EnableEvents = True Set MonOutlook = Nothing Set MonMessage = Nothing End Sub
Re,
Dans le répertoire qu'indique ton message d'erreur, sur mon poste, rien !...
Complétement vide, avant et après avoir exécutée la procédure.
Je viens de tester ma procédure et elle fonctionne sans problème (envoi à 2 adresses différentes et ouverture fichiers sur un PC et un Mac).
Je ne peux pas t'en dire plus.
Cdlt.