Enregistrement d'un fichier plus mettre en pièces jointes d'un mail

Question

Bonjour à tous,
je voudrais regrouper les 2 macros ci-dessous elle fonctionne très bien séparément.
et il me faudrait le fichier que j'enregistre avant soit ma pièce jointe du mail que je souhaite envoyer après.
si vous avez une idée ou voulez-vous plus de détails n'hésitez pas...
Merci de votre aide.
Baptiste "le débutant VBA"

Sub JOKER6H()
'
' JOKER6H Macro
'

'
Range("1:1,3:3").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A1:C1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.FormulaR1C1 = "JOKER 6H"
Range("D1").Select
'Enregistrement fichier sous
Dim fichier As String
'Emplacement du fichier
fichier = "A:\ADV-EXPLOITATION\EXPLOITATION\Logistique\Intersites\JOKER\" & Format(Now + 1, "dd.mm.yy ") & "6H.xlsx"

ChDir "A:\ADV-EXPLOITATION\EXPLOITATION\Logistique\Intersites\JOKER"
ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
fermer
End Sub

Sub Mail_Outlook()

Dim ObjOutlook As New Outlook.Application

Dim oBjMail

Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

With oBjMail

'le destinataire

.To = "XXXX"

'Copie

.CC = "XXX"

'l'objet du mail

.Subject = "JOKER 6H "

.Body = "Bonjour," & vbNewLine & "Ci joint le reassort du " & vbNewLine & "Merci"

'le corps du mail ..son contenu'

.Display ' Ici on peut supprimer pour l'envoyer sans v?rification

End With

Set oBjMail = Nothing

Set ObjOutlook = Nothing

End Sub

Abderrahmane BENALI · Accepted Answer

Bonjour,

Vous pouvez simplement combiner les deux macros en une seule. J'ai ajouté quelques lignes de code pour attacher le fichier enregistré à votre courrier électronique.
A tester :

Sub JOKER6H_and_Mail_Outlook()
'
' JOKER6H_and_Mail_Outlook Macro
'

Range("1:1,3:3").Select
Range("A3").Activate
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("A1:C1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveCell.FormulaR1C1 = "JOKER 6H"
Range("D1").Select
'Enregistrement fichier sous
Dim fichier As String
'Emplacement du fichier
fichier = "A:\ADV-EXPLOITATION\EXPLOITATION\Logistique\Intersites\JOKER\" & Format(Now + 1, "dd.mm.yy ") & "6H.xlsx"

ChDir "A:\ADV-EXPLOITATION\EXPLOITATION\Logistique\Intersites\JOKER"
ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'fermer -- vous pouvez commenter cette ligne si vous voulez que le fichier reste ouvert

'Envoi de mail avec Outlook
Dim ObjOutlook As Object
Dim oBjMail As Object

Set ObjOutlook = CreateObject("Outlook.Application")
Set oBjMail = ObjOutlook.CreateItem(0)

With oBjMail
.To = "XXXX"
.CC = "XXX"
.Subject = "JOKER 6H "
.Body = "Bonjour," & vbNewLine & "Ci joint le reassort du " & vbNewLine & "Merci"
.Attachments.Add fichier 'ici nous ajoutons le fichier enregistré en tant que pièce jointe
.Display ' ici on peut supprimer pour l'envoyer sans vérification
End With

Set oBjMail = Nothing
Set ObjOutlook = Nothing

End Sub

N'oubliez pas de remplacer "XXXX" et "XXX" par les adresses e-mail appropriées. J'espère que cela vous aidera !

Abderrahmane BENALI · Answer

Ca parait logique ce que je vais dire mais assurez-vous d'avoir une version de Microsoft Outlook installée sur votre ordinateur, car cette macro ne fonctionnera pas sans elle...

Abderrahmane BENALI · Answer

Vous pouvez utiliser la méthode GetInspector pour activer la fenêtre d'édition de l'e-mail, ce qui ajoutera automatiquement votre signature si vous en avez configuré une dans Outlook : With oBjMail .To = "XXXX" .CC = "XXX" .Subject = "JOKER 6H " .Body = "Bonjour," & vbNewLine & "Ci joint le reassort du " & vbNewLine & "Merci" .Attachments.Add fichier 'ici nous ajoutons le fichier enregistré en tant que pièce jointe .Display ' ici on peut supprimer pour l'envoyer sans vérification ' Ajout de la signature .GetInspector ' Cette ligne va ajouter la signature d'Outlook par défaut End With Cette méthode insère la signature au début du corps du courrier, donc si vous avez déjà défini le corps du courrier avec .Body , votre signature sera placée avant ce texte. Pour l'éviter, vous pouvez ajouter votre texte après l'insertion de la signature, de cette façon : With oBjMail .To = "XXXX" .CC = "XXX" .Subject = "JOKER 6H " .Attachments.Add fichier 'ici nous ajoutons le fichier enregistré en tant que pièce jointe .Display ' ici on peut supprimer pour l'envoyer sans vérification ' Ajout de la signature .GetInspector ' Cette ligne va ajouter la signature d'Outlook par défaut ' Ajout du texte du mail après la signature .Body = "Bonjour," & vbNewLine & "Ci joint le reassort du " & vbNewLine & "Merci" & vbNewLine & .Body End With...