XL 2016 Modification d'une Macro d'envoi d'email

Sylvain29

XLDnaute Nouveau
Bonjour tout le monde,

grâce à l'aide de ce forum j'ai pus il y à quelques temps réaliser une macro pour envoyer un document Excel par mail en format pdf (avec un bouton).
J'aimerai si cela est possible faire la même chose mais en restant en format Excel. (Création d'un mail avec la feuille en pièce jointe)
Ci-dessous ma macro actuelle. Est-elle modifiable dans ce sens ou faut-il repartir à zéro?
VB:
Sub ENVOIMAIL1()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

' Créer une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop")
Set WshShell = Nothing
' Définit le nom du fichier à enregistrer
sNomFic = Range("B15") & ".pdf"
' Enregistrer la feuille en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Range("E20")
.CC = ""
.Attachments.Add (sRep & "\" & sNomFic)
.Subject = "DEVIS-" & Range("B15")
.body = Range("B110")
.display
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Kill (sRep & "\" & sNomFic)
End Sub
 

patricktoulon

XLDnaute Barbatruc
Bonjour
et bien c'est simple
a la place de ca
VB:
sNomFic = Range("B15") & ".pdf"
' Enregistrer la feuille en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

tu met ceci
VB:
  sNomFic = Range("B15") & ".xlsx"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=sRep & "\" & sNomFic, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
;)
 

Sylvain29

XLDnaute Nouveau
Bonjour
et bien c'est simple
a la place de ca
VB:
sNomFic = Range("B15") & ".pdf"
' Enregistrer la feuille en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

tu met ceci
VB:
  sNomFic = Range("B15") & ".xlsx"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=sRep & "\" & sNomFic, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
;)
Merci beaucoup @patricktoulon ; ça génère bien un mail avec le classeur en pièce jointe.
J'aimerais que le mail s'ouvre avant l'envoi.
Dans la configuration actuelle ça ouvre une boite de dialogue "vous devez enregistrer le classeur avant d'envoyer le courriel", puis une seconde "Un programme tente d'envoyer un courrier en votre nom etc. si je clic "accepter" ça envoi le mail.
Est-ce possible de supprimer ces boîtes de dialogue et d'ouvrir le mail avant de l'envoyer?
Encore merci pour ton aide !
Sylvain29
 

Discussions similaires

Réponses
17
Affichages
1 K

Statistiques des forums

Discussions
311 720
Messages
2 081 899
Membres
101 834
dernier inscrit
Jeremy06510