Enregistrer et Attacher en PJ un format Excel format XLSX
y
Bonjour,
J'ai besoin de votre aide pour modifier le code VBA que j'utilise habituellement.
Après avoir configuré mon outil, je lance le code me permettant :
- D'enregistrer sous .pdf la feuille Excel qui m'intéresse via un lien prédéfini,
- De générer un mail via Outlook,
- De rattacher en PJ le PDF préalablement enregistré dans le mail.
Or désormais, j'ai besoin de modifier le process de la manière suivante
- Enregistrer sous .xlsx l'intégralité des feuilles via un lien prédéfini,
- De générer un mail via Outlook,
- De rattacher en PJ l'Excel préalablement enregistré dans le mail.
Voici le code utilisé actuellement :
Sub PROCESS_SEND()
Dim NOM As String
Dim rng As Range
' définition de la mise en page de la fiche de demande d'offre
Set rng = Sheets("BASE TEST").Range("A1:O30")
Dim fileName, Utilisateur As String
' titre du fichier pdf
NOM = Sheets("DATA SEND").Range("B1")
' lieu d'enregistrement + titre document
fileName = "C:\Users\Desktop\PROJET\DEMANDE\" & NOM & ".pdf"
' code complémentaire pour enregistrement du fichier PDF
rng.ExportAsFixedFormat Type:=xlTypePDF, _
fileName:=fileName, Quality:=xlQualityHigh, _
IncludeDocProperties:=False, IgnorePrintAreas:=False
' ce qui va faire le lien entre outlook et excel
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
send = False
' configuration du mail
With OutMail
.To = Sheets("DATA SEND").Range("B2").Value
.CC = Sheets("DATA SEND").Range("B3").Value & ";" & Sheets("setting FDO").Range("G6").Value
.Subject = Sheets("DATA SEND").Range("B4").Value
.Body = Sheets("DATA SEND").Range("B5").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B6").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B7").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B8").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B9").Value & vbCrLf _
' insertion de la pièce jointe
.Attachments.Add "C:\Users\Desktop\PROJET\DEMANDE\" & NOM & ".pdf"
If send = True Then
.send
Else
.Display
End If
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Merce d'avance pour votre aide !!
Cordialement
Bonjour Ynct2496,
Je te propose le code suivant :
Sub PROCESS_SEND_EXCEL()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Send = False
' configuration du mail
With OutMail
.To = Sheets("DATA SEND").Range("B2").Value
.CC = Sheets("DATA SEND").Range("B3").Value & ";" & Sheets("setting FDO").Range("G6").Value
.Subject = Sheets("DATA SEND").Range("B4").Value
.Body = Sheets("DATA SEND").Range("B5").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B6").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B7").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B8").Value & vbCrLf _
& vbCrLf _
& Sheets("DATA SEND").Range("B9").Value & vbCrLf _
' insertion de la pièce jointe
.Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
If Send = True Then
.Send
Else
.Display
End If
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
y
Merci Gérard !
Je test le code dès Mardi !
Cordialement.