Envoyez un doc (en .docx) par mail, en gardant le document actif en .docm

Bonjour comment envoyez un doc (en .docx) par mail, tout en gardant le document actif en .docm.

Sub Envoi_Mail_Hab()

Dim applOL As Object

Dim miOL As Object

Dim recptOL As Object

Dim strMail As String, strFileName As String

Dim fileSaveName As Variant

Dim MySave As Object

Dim strObjet As String

Dim chemin As String

Dim email As String

Dim NewName As String

Dim File_Names As String

Dim Source_Folder_Path As String, Target_Folder_Path As String

Dim doc As Document

chemin = "\\CERATA\mdir\Expérience Utilisateurs\01 - Procédures Service Desk & Habiliations"

strFileName = chemin & "\" & ActiveDocument.Name ' Le nom complet du fichier (chemin + nom + extension)

strObjet = ActiveDocument.Name

Set applOL = CreateObject("Outlook.Application")

Set miOL = applOL.CreateItem(0)

With miOL

.To = "dl-ma-mgmt@gmail.com;"

.CC = "yes@gmail.com;"

.Subject = strObjet

' "De" adresse envoi de mail

.SentOnBehalfOfName = "procedures_workplace_serv@gmail.com"

.ReplyRecipients.Add ("procedures_workplace_serv@gmail.com") ' Optionnelle, sinon les réponses seront acheminées à la boîte d’envoi

.Body = "Bonjour, Veuillez trouvez ci-joint la procédure de " & ActiveDocument.Name 'ou

.Attachments.Add (strFileName) ' Optionnelle, mais permet de joindre un ou des fichier(s) au courriel, car cette commande peut être répétée

' Préférable d’identifier de quelle boîte de courriel le courriel va partir

Set .SendUsingAccount = applOL.Session.Accounts.Item(1)

.Display ' Ouvre et montre le courriel sans l’envoyer

End With

Set applOL = Nothing

Set miOL = Nothing

Set recptOL = Nothing

End Sub