Envoie email

Bonjour à tous.

J'ai aujourd'hui un bouton avec le code suivant qui me permet d'enregistrer la feuille active en xlsm et pdf.

Est-ce que c'est possible de mettre le pdf en pièce jointe d'un email. j'utilise outlook 2010.

Sub enregistredevis()
Dim Chemin As String, Fichier As String

  Fichier = Range("F11") & " " & Range("F4") & " " & Range("F5")
  If Len(Trim(Fichier)) = 0 Then
    MsgBox "Pas de nom de fichier"
    Exit Sub
  End If

  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "g:\dossier\dossier2\Devis"
    If .Show = -1 Then    ' Clic sur Ok
     Chemin = .SelectedItems(1)
    Else
      ' Clic sur Annuler
     Exit Sub
    End If
  End With
  MkDir Chemin & "\" & Fichier
  Chemin = Chemin & "\" & Fichier
  ActiveSheet.Copy
  With ActiveWorkbook
    .SaveAs Filename:=Chemin & "\" & Fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    .Close
  End With

  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & Fichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End Sub

merci

Quelqu'un a une idee?

Un exemple à adapter :

Option Explicit
Sub envoi()

Dim messagerie As Object
Dim email As Object
Dim nompdf As String

On Error GoTo erreur

    nompdf = Environ("Temp") & "\" & "fichier test"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    Set messagerie = CreateObject("Outlook.Application")
    Set email = messagerie.CreateItem(0)
    With email
        .to = Sheets("param").Range("B1")
        .Subject = Sheets("param").Range("B2")
        .body = "test"
        .ReadReceiptRequested = True
        .Attachments.Add nompdf & ".pdf"
        .display
    End With
    Set email = Nothing
    Set messagerie = Nothing

    Kill Environ("Temp") & "\" & "fichier test" & ".pdf"

Exit Sub

erreur:

    MsgBox "Erreur : " & Err.Number & vbLf & Err.Description

End Sub
Rechercher des sujets similaires à "envoie email"