' [url=http://www.rondebruin.nl/win/s1/cdo.htm]Sending mail from Excel with CDO[/url]
Sub EnvoisPDF()
Dim sPath As String, sFic As String
Dim ObjMessage As Object
' Définir le chemin d'accès au fichier PDF
sPath = "C:\Users\Rafael\Documents\"
' Définir le nom du fichier
sFic = Format([H15], "yyyymmddhhmm") & [B16] & ".pdf"
' Exporte la feuille dans ce répertoire
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & sFic, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'
MsgBox "Votre facture est prête pour l'impression !"
' Définir l'objet CDO
Set ObjMessage = CreateObject("CDO.Message")
' Avec l'objet
With ObjMessage
' Définir la configuration d'envoi
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Nom du serveur SMTP=serveur FAI"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
' Définir les options d'envois
.Subject = "Sujet du Message"
.From = "xxx@hotmail.com"
.To = "destinataire"
.TextBody = "Bonjour," & vbCrLf & "Veuillez trouver en piéce jointe votre facture" & vbCrLf
' Ne pas oublier de joindre le fichier
.AddAttachment sPath & sFic
' Envoyer le mail
.Send
End With
End Sub