VBA envoyer le fichier courant par mail en pièce jointe

[tibtelcom]

Bonjour, j'ai un fichier protégé par mot de passe et dont les feuilles sont aussi protégées par mot de passe. Je souhaite en appuyant sur un bouton, envoyer ce fichier par mail en pièce jointe en enlevant la protection puis une fois le fichier envoyé le réenregistrer dans un répertoire prédéfini en activant de nouveau la protection.
j'ai un problème au niveau de l'envoi de la pièce jointe
Pour le moment j'ai ce code qui ne fonctionne pas :

Sub EnvoiMail_Outlook()
'Creation de l'objet e-mail
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String
Dim obj As String
Dim NomFichier, NomDefaut As String

Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
'NOM , Mois et Annee sont des cellules de mon fichier
NomDefaut = Range("NOM").Value & "_" & Range("Mois").Value & Range("Annee").Value
'Enlever la protection du fichier
Application.Dialogs(xlDialogProtectDocument).Show

'Enregistrer le fichier sans la protection
NomFichier = Application.GetSaveAsFilename(NomDefaut, "Microsoft Excel (*.xls), *.xls")

If NomFichier = False Then
MsgBox "Enregistrement annulé."
Else
MsgBox NomFichier
End If

'Envoi du mail
'Caractéristiques de l'e-mail
With olmail
'Destinataire
.To = "X@Y.fr"
'Objet du message
obj = Range("NOM").Value & "_" & Range("Mois").Value & Range("Annee").Value
.Subject = obj
.Body = "Voici mon relevé des temps passés sur chaque affaire pour le mois : " & Range("Mois").Value & "/" & Range("Annee").Value & vbCrLf & Range("NOM").Value

'envoi de la pièce jointe
.Attachments.Add "C:\Mes Documents\"&NomDefaut&".xls"
'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
.Display
End With

'Remettre la protection du fichier
Application.Dialogs(xlDialogProtectDocument).Show

'Enregistrer le fichier avec la protection
NomFichier = Application.GetSaveAsFilename(NomDefaut, "Microsoft Excel (*.xls), *.xls")

If NomFichier = False Then
MsgBox "Enregistrement annulé."
Else
MsgBox NomFichier
End If
End Sub

l'erreur se trouve dans la partie envoi de la pièce jointe,
Par aillerus il est fort possible que je n'ai pas choisi la bonne méthode pour envoyer le fichier courant puisque j'enleve la protection, je l'enregistre, j'envoie le mail avec le fichier, je remet la protection et enfin je l'enregistre (je trouve cela un peu lourd non ?)
Si vous avez des idées, je vous remercie

 

[tibtelcom]

Re : VBA envoyer le fichier courant par mail en pièce jointe

Sub EnvoiMail_Outlook()
'Creation de l'objet e-mail
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String
Dim obj As String
Dim NomFichier, NomDefaut As String

Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
'NOM , Mois et Annee sont des cellules de mon fichier
NomDefaut = Range("NOM").Value & "_" & Range("Mois").Value & Range("Annee").Value
'Enlever la protection du fichier
Application.Dialogs(xlDialogProtectDocument).Show

'Enregistrer le fichier sans la protection
NomFichier = Application.GetSaveAsFilename(NomDefaut, "Microsoft Excel (*.xls), *.xls")

If NomFichier = False Then
MsgBox "Enregistrement annulé."
Else
MsgBox NomFichier
End If

'Envoi du mail
'Caractéristiques de l'e-mail
With olmail
'Destinataire
.To = "X@Y.fr"
'Objet du message
obj = Range("NOM").Value & "_" & Range("Mois").Value & Range("Annee").Value
.Subject = obj
.Body = "Voici mon relevé des temps passés sur chaque affaire pour le mois : " & Range("Mois").Value & "/" & Range("Annee").Value & vbCrLf & Range("NOM").Value

'envoi de la pièce jointe
.Attachments.Add "C:\Mes Documents\"&NomDefaut&".xls"
'Remplacez .Display par .send pour envoyer directement l'e-mail sans l'afficher dans Outlook
.Display
End With

'Remettre la protection du fichier
Application.Dialogs(xlDialogProtectDocument).Show

'Enregistrer le fichier avec la protection
NomFichier = Application.GetSaveAsFilename(NomDefaut, "Microsoft Excel (*.xls), *.xls")

If NomFichier = False Then
MsgBox "Enregistrement annulé."
Else
MsgBox NomFichier
End If
End Sub

Poser des questions n'empêche pas de chercher, j'ai mis :
.Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
pour traiter l'envoi de la pièce jointe mais quand j'ouvre la pièce jointe, elle est toujours protégée par mot de passe et l'enregistrement fait par Application.getsaveasfilename n'a pas marché. la dessus pour le moment je sèche.
Merci