Envoie email
p
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
p
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