Ouvrir messagerie pour envoi d'email avec PJ

Bonjour à tous,

Je suis à la recherche d'une macro Excel pour faire la chose suivante :

Ouvrir une fenêtre de nouveau message par Outlook avec les champs suivants :

En destinataire, la cellule E42 de l'onglet "Feuille Diags" de la feuille "Devis Basique.xlsx", en sujet, "Envoi du devis", en pièce jointe, la copie de l'onglet "Devis" de la feuille "Devis Basique.xlsx" au format PDF et un corps de texte au choix.

J'ai essayé des macros trouvables sur le net mais rien ne fonctionne comme je le voudrais.

Merci d'avance!

Dim strPath$, OutlookItem, ColAttach
Const olByValue = 1
Set OutlookItem = Application.CreateItem(0)
OutlookItem.To = Workbooks("Devis Basique.xlsx").sheets("Feuille Diags").range("E42")
OutlookItem.Subject = "Envoi du devis"
x = inputbox("Coprs de texte au choix")
OutlookItem.Body = x
Set ColAttach = OutlookItem.Attachments
Workbooks("Devis Basique.xlsx").sheets("Devis").range("A1:F50").ExportAsFixedFormat Type:=xlTypePDF, _
   fileName:="C:\devis.pdf" Quality:=xlQualityStandard, _
   IncludeDocProperties:=True, IgnorePrintAreas:=True, _
   From:=1, To:=1, OpenAfterPublish:=False
strPath = "C:\devis.pdf"
ColAttach.Add strPath, olByValue, 1, "File Attachment"
OutlookItem.Display
Kill "C:\devis.pdf"

Merci pour cette macro, j'ai rajouté Sub Macro1 () au début et End Sub à la fin et j'obtiens une erreur de compilation (erreur de syntaxe).

J'ai également toute la partie :

Workbooks("Devis Basique.xlsx").sheets("Devis").range("A1:F50").ExportAsFixedFormat Type:=xlTypePDF, _

fileName:="C:\devis.pdf" Quality:=xlQualityStandard, _

IncludeDocProperties:=True, IgnorePrintAreas:=True, _

From:=1, To:=1, OpenAfterPublish:=False

en rouge.

Merci pour l'aide!

Version office ?

2013

Workbooks("Devis Basique.xlsx").sheets("Devis").range("A1:F50").ExportAsFixedFormat Type:=xlTypePDF, fileName:="C:\devis.pdf", IgnorePrintAreas:=True,  OpenAfterPublish:=False

La partie n'est plus en rouge mais maintenant j'ai le message "Propriété ou méthode non gérée par cet objet".

Edit :

J'ai donc :

Sub Macro1()
    Dim strPath$, OutlookItem, ColAttach
    Const olByValue = 1
    Set OutlookItem = Application.CreateItem(0)
    OutlookItem.To = Workbooks("Devis Basique.xlsx").Sheets("Feuille Diags").Range("E42")
    OutlookItem.Subject = "Envoi du devis"
    x = InputBox("Coprs de texte au choix")
    OutlookItem.Body = x
    Set ColAttach = OutlookItem.Attachments
    Workbooks("Devis Basique.xlsx").Sheets("Devis").Range("A1:F50").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\devis.pdf", IgnorePrintAreas:=True, OpenAfterPublish:=False
    strPath = "C:\devis.pdf"
    ColAttach.Add strPath, olByValue, 1, "File Attachment"
    OutlookItem.Display
    Kill "C:\devis.pdf"
End Sub

Tu dois activer la référence Outlook Object Library ....

Edit : j'ai trouvé et j'ai la version 15 de cochée.

Edit 2 : j'ai de coché VB for applications / Excel 15 Object Library / OLE Automation / Office 15 Object Library / Outlook 15 Object Library

Et j'ai toujours le même problème.

Sub Macro1()
    Dim strPath$, OutlookItem, ColAttach
Dim myOlApp As Outlook.Application
Dim outlookitem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
    Const olByValue = 1
    Set OutlookItem =myOlApp.CreateItem(olMailItem)
    OutlookItem.To = Workbooks("Devis Basique.xlsx").Sheets("Feuille Diags").Range("E42")
    OutlookItem.Subject = "Envoi du devis"
    x = InputBox("Coprs de texte au choix")
    OutlookItem.Body = x
    Set ColAttach = OutlookItem.Attachments
    Workbooks("Devis Basique.xlsx").Sheets("Devis").Range("A1:F50").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\devis.pdf", IgnorePrintAreas:=True, OpenAfterPublish:=False
    strPath = "C:\devis.pdf"
    ColAttach.Add strPath, olByValue, 1, "File Attachment"
    OutlookItem.Display
    Kill "C:\devis.pdf"
End Sub

Bon je ne comprends pas pourquoi ça ne marcherait pas.. Allez amusons nous à tout déclarer..

J'obtiens :

Erreur de compilation : déclaration existante dans la portée en cours sur la ligne Dim outlookitem As Outlook.MailItem

Dim outlookitem As myolapp.MailItem

Et vire le de la première ligne...

Si j'ai bien compris, j'ai mis :

Sub Macro1()
    Dim strPath$, ColAttach
Dim myOlApp As Outlook.Application
Dim outlookitem As myOlApp.MailItem
Set myOlApp = CreateObject("Outlook.Application")
    Const olByValue = 1
    Set outlookitem = myOlApp.CreateItem(olMailItem)
    outlookitem.To = Workbooks("Devis Basique.xlsx").Sheets("Feuille Diags").Range("E42")
    outlookitem.Subject = "Envoi du devis"
    x = InputBox("Coprs de texte au choix")
    outlookitem.Body = x
    Set ColAttach = outlookitem.Attachments
    Workbooks("Devis Basique.xlsx").Sheets("Devis").Range("A1:F50").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\devis.pdf", IgnorePrintAreas:=True, OpenAfterPublish:=False
    strPath = "C:\devis.pdf"
    ColAttach.Add strPath, olByValue, 1, "File Attachment"
    outlookitem.Display
    Kill "C:\devis.pdf"
End Sub

Et j'ai toujours la même erreur de compilation avec outlookitem As myOlApp.MailItem surligné.

Edit : c'est l'erreur de compilation : typé défini par l'utilisateur non défini.

Bon...

Preuve que je ne suis pas très fort.. J'ai du allumer mon ordi avec outlook pour débeuger àa la mano

Ca marche

Sub Macro1()
    Dim strPath$, ColAttach
Dim myOlApp As Outlook.Application
Dim outlookitem As outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
  Set outlookitem = myOlApp.CreateItem(olMailItem)
    Const olByValue = 1
    outlookitem.To = Workbooks("Devis Basique.xlsx").Sheets("Feuille Diags").Range("E42")
    outlookitem.Subject = "Envoi du devis"
    x = InputBox("Coprs de texte au choix")
    outlookitem.Body = x
    Set ColAttach = outlookitem.Attachments
    Workbooks("Devis Basique.xlsx").Sheets("Devis").Range("A1:F50").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\devis.pdf", IgnorePrintAreas:=True, OpenAfterPublish:=False
    strPath = "C:\devis.pdf"
    ColAttach.Add strPath, olByValue, 1, "File Attachment"
    outlookitem.Display
    Kill "C:\devis.pdf"
End Sub

Je viens de la copier et j'ai une erreur : l'indice n'appartient pas à la sélection...

Malheureusement, comme je n'y connais pas grand chose, je sais même pas ce que ça veut dire.

Workbooks("Devis Basique.xlsx").Sheets("Feuille Diags")

Workbooks("Devis Basique.xlsx").Sheets("Devis")

L'un de ces noms n'est pas présent dans tes fichiers ouverts..

Vérifie que le workbook Devis Basique.xlsx est ouvert et qu'il contient bien les feuilles Devis et Feuille Diags et que c'est bien écrit sans espaces...

Ah bah c'était une erreur d'extension, pas xlsx mais xlsm pour les macros...

Du coup j'ai bien la boite pour taper le corps du texte mais j'ai une erreur 400 juste après...

Peux tu joindre ton fichier ?

Oui, le voilà.

Pour la macro, y a un bouton en J45 sur la "Feuille Diags".

Sub Macro1()
    Dim strPath$, ColAttach
Dim myOlApp As Outlook.Application
Dim outlookitem As Outlook.MailItem
Set myOlApp = CreateObject("Outlook.Application")
    Set outlookitem = myOlApp.CreateItem(olMailItem)
        Const olByValue = 1
        outlookitem.To = Workbooks("Devis Basique.xlsm").Sheets("Feuille Diags").Range("E42")
        outlookitem.Subject = "Envoi du devis"
        x = InputBox("Coprs de texte au choix")
        outlookitem.Body = x
        Set ColAttach = outlookitem.Attachments
       Workbooks("Devis Basique.xlsm").Sheets("Devis").Range("B2:L78").ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\tonuser\Desktop\devis.pdf", IgnorePrintAreas:=True, OpenAfterPublish:=False
        strPath = "C:\Users\tonuser\Desktop\devis.pdf"
        ColAttach.Add strPath, olByValue, 1, "File Attachment"
        outlookitem.Display
        Kill "C:\Users\tonuser\Desktop\devis.pdf"
End Sub

Je pense que tu ne dois pas pouvoir écrire à la racine...

Crée toi un dossier sur ton bureau et change les trois chemins

"C:\Users\tonuser\Desktop\devis.pdf"