XL 2019 Envoyer une feuille par mail en pdf

[pat66]

Bonjour le forum

Actuellement, ce classeur .xlsm s'enregistre en pdf grâce à une macro qui fonctionné bien, mais je souhaiterai ajouté une macro qui permette d'envoyer la feuille " transmettre " par mail et en PDF avec ou sans Outlook

Veuillez trouver ci joint le classeur concerné

par avance je vous remercie pour votre aide

Pat66

 

[Bernard_XLD]

Bonjour pat66, le forum

avec ou sans Outlook

tu veux quoi exactement ? deux procédures ? ou tu te moques de quel gestionnaire de mails va être utilisé ?

Cordialement, @+

 

[pat66]

Bonjour Yeahou, le forum

Les 2 me permettrait de tester mais à choisir je préfère sans Outlook, et je me moque du gestionnaire qui sera utilisé et je suis chez sfr

merci

 

[pat66]

Bonjour Yeahou, le forum

c'est bon j'ai résolu mon problème

en tout cas merci

pat66

 

[Lolote83]

Bonjour à tous.
Bravo si tu as réussi à résoudre ton problème.
L'idée serait aussi que tu partages ta solution qui du coup, pourrait aussi servir à quelqu'un d'autre.
Cordialement
@+ Yvan

 

[pat66]

Bonjour Lolote83, le forum
avec plaisir, voici la solution pour un envoi en CDO, mais je ne sais pas utiliser les balises et je suis sur qu'il y a quelques erreurs, mais cela fonctionne bien

Option Explicit
Public Const ParamSendUsing As String = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Public Const ParamServeur As String = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Public Const ParamPort As String = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Public Const ParamIdentificateur As String = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Public Const ParamIdentifiant As String = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Public Const ParamMotDePasse As String = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Public Const ParamSsl As String = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

Sub EnvoiMailCDO()
Dim CdoMessage, CdoConfig, CdoParam
'Dim Fichier As String
Dim Var1 As String ' nom
Dim Chemin As String 'chemin du fichier
Dim NFichier As String 'Nom du fichier
Dim titre As String
Dim strbody As String
Var1 = [D6].Value 'Nom du client : exemple ==> Dupont
If Var1 = Empty Then
MsgBox "Veuillez préciser le nom et le prénom.", vbYes, "PL"
Exit Sub
End If
Application.ScreenUpdating = False
Dim Sh1 As Worksheet
Set Sh1 = Feuil5 'A adapter si besoin en fonction du codename de la feuille 1
With Sh1.PageSetup
.PrintArea = "A1:N115" 'Zone d'impression à adapter de la feuille 1
.Zoom = False
.FitToPagesWide = 3
.FitToPagesTall = 3
'Réglage des marges
.LeftMargin = Application.InchesToPoints(1.2) 'Marge gauche
.RightMargin = Application.InchesToPoints(0.1) 'Marge droite
.TopMargin = Application.InchesToPoints(0.5) 'Marge haut de page
.BottomMargin = Application.InchesToPoints(0.1) 'Marge bas de page
.Orientation = xlLandscape 'Paysage ' .Orientation = xlPortrait 'Portrait
End With
Sheets(Array(Sh1.name)).Select

Chemin = Application.ActiveWorkbook.Path ' 'direction du fichier pdf
'If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin

NFichier = ThisWorkbook.Path & "\" & "PROSPECT" & "-" & Sh1.Range("h3") & "-" & Format(Date, "dd-mm-yyyy") & ".pdf" 'Création du fichier pdf
'Création du fichier PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=NFichier, Quality _
:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set CdoConfig = CreateObject("CDO.Configuration")

CdoConfig.Load -1
Set CdoParam = CdoConfig.Fields

With CdoParam
.Item(ParamSendUsing) = 2
.Item(ParamServeur) = [T9].Value
.Item(ParamPort) = [T10].Value
.Item(ParamIdentificateur) = "1"
.Item(ParamIdentifiant) = [T12].Value 'Votre Identifiant
.Item(ParamMotDePasse) = [T13].Value 'Votre mot de passe
.Item(ParamSsl) = "true"
.Update
End With

Set CdoMessage = CreateObject("CDO.Message")
With CdoMessage
Set .Configuration = CdoConfig
.From = [T4].Value
.To = [T5].Value
.CC = [T6].Value 'destinataires en copie (CC)
.BCC = [T7].Value 'destinataires en copie cachée (CCI)
.Subject = titre & " " & [H3] 'sujet
.TextBody = strbody

strbody = "Bonjour," & vbNewLine & vbNewLine & "veuillez trouver ci-joint le relevé d'information de " & [D5] & " " & [H3] & vbNewLine & vbNewLine
strbody = strbody & "Cordialement" & vbNewLine & vbNewLine
strbody = strbody & "Service commercial" & " : " & [T3]

.Fields("urn:schemas:mailheader:disposition-notification-to") = [T4].Value
.Fields("urn:schemas:mailheader:return-receipt-to") = [T4].Value
.Fields.Update
.AddAttachment NFichier
.Send
End With
MsgBox "Le relevé a bien été envoyé !"
Kill NFichier
Set CdoMessage = Nothing
Set CdoConfig = Nothing
Set CdoParam = Nothing
Set Sh1 = Nothing 'Decharge la feuille 1
Application.ScreenUpdating = True
End Sub

Pat66