Envoi d'email Outlook avec Activeworkbook en PJ

Résolu
Maxmen -  
 maxmen -
Bonjour,

Je réalise actuellement un formulaire qui permet l'envoi direct du fichier excel par simple pression d'un bouton.

J'ai déjà réalisé le code pour ouvrir un nouvel e-mail via outlook, mais je n'arrive pas à intégrer l'Activeworkbook en PJ.

Quelqu'un aurait-il la solution ?

Merci d'avance!

Sub Emailoutlook()

Application.DisplayAlerts = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "***@***"
.CC = "***@***"
'.BCC = "***@***"
.Subject = "test"
'.Body
.attachments.Add (ActiveWorkbook)
.Display

End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
Application.DisplayAlerts = True

End Sub


4 réponses

cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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
0
maxmen
 
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" ...
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
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!


0
maxmen
 
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
0