Envoi d'email Outlook avec Activeworkbook en PJ

Bonjour,

voici un exemple:

https://forum.excel-pratique.com/viewtopic.php?forum_uri=cours-astuces&t=29003&start=

il ne faut pas mettre ceci:

.attachments.Add (ActiveWorkbook)

mais cela:

.attachments.Add chemin du fichier

Merci pour la réponse!

le code de l'autre post fonctionne.

Par contre, j'aimerais éviter de devoir entrer un chemin pour l'insertion de la PJ.

J'arrive à envoyer l'ActiveWorkbook directement avec le code ci-dessous:

Sub envoimail()

ActiveWorkbook.SendMail Recipients:="***@***", _
Subject:="test", _
ReturnReceipt:=True

End Sub

et j'aimerais intégrer cette fonction au code suivant:

Sub Envoyer_Mail_Outlook()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
   
    Set ObjOutlook = New Outlook.Application
    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
'---------------------------------------------------------
   'Exemple pour envoyer un classeur en pièce jointe
  ' Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
   'If Nom_Fichier = "Faux" Then Exit Sub
'---------------------------------------------------------
   'Ou bien entrer le path et nom du fichier autrement
  ' Nom_Fichier = "C:\Chemin\NomFichier.ext"
   ' If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------

     With oBjMail
        .To = "***@***" ' le destinataire
       .Subject = "Ici c'est l'objet"          ' l'objet du mail
       .Body = "Ici le texte du mail "  'le corps du mail ..son contenu
       .Attachments.Add  '"C:\Data\essai.txt" ' ou Nomfichier
       .Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       '.Send
    End With
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
End Sub

C'est pour cette raison que j'essaye de trouver une solution avec la combinaison du ".Attachments.Add" + "Activeworkbook" ...

regarde ce que fait ce code:

Private Sub test()
'nom
MsgBox ActiveWorkbook.Name
'chemin dossier
MsgBox ActiveWorkbook.Path
'chemin complet
MsgBox ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
End Sub

et voilà, tout est prévu en vba!

Super, Merci @Le Pivert!

Voici ma mayonnaise :

J'ai d'abord fait appel à un SaveBox pour stocker l'Activeworkbook sur le PC (permet d'avoir deux actions en une manip. )

Le code fait ensuite un controle de l'activation du "microsoft outlook object" (important pour lancer outlook depuis un PC quelconque).
Dans mon cas j'ai le chemin pour un PC sous win. 7 avec office 2010 => standard de l'entreprise (voir lien ci-dessous):

Shell("C:\Program Files (x86)\Microsoft Office\Office14\MSOUTL.OLB")

J'enregistre ensuite le "path" dans une cellule pour intégrer le fichier excel dans l'e-mail.

Et pour finir je compose mon mail avec oBjMail...

Le code fonctionne nickel!

Sub mess()
   
Dim objSaveBox As FileDialog

'ouverture de la fenetre
Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)
 
With objSaveBox
    'Nom du fichier
.InitialFileName = Sheets("******").Range("******")
 
    'Définir le type de fichier
.FilterIndex = 2
 
'Afficher boîte de dialogue
.Show
'.Enregistre
.Execute
    
End With

Dim OL As Object
  Dim OLmail As Object
  On Error Resume Next
  Set OLk_Appli = GetObject("Outlook.Application")
  If OLk_Appli Is Nothing Then
    OLk_OK = Shell("C:\Program Files (x86)\Microsoft Office\Office14\MSOUTL.OLB")
  
  End If

Dim Nom_Fichier As String
    
Sheets("****").Range("******") = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
   
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

   'Variable nom du fichier
Nom_Fichier = Sheets("******").Range("******")
If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
With oBjMail

.To = "***@***" ' le destinataire
.Subject = Sheets("*******").Range("******")      ' l'objet du mail
.Body = Sheets("******").Range("******") & vbCrLf & Sheets("*****").Range("******") & vbCrLf 
.Attachments.Add Nom_Fichier 'Mettre en PJ le fichier
.Display  'voir mail
'.Send
End With
'ObjOutlook.Quit
Set oBjMail = Nothing
Set ObjOutlook = Nothing

End Sub