Code pour envoi par mail mais changer nom fichier envoyé (Résolu)

[Cougar]

Bonjour le forum,

J'utilise ce code pour l'envoi par mail :

Destinataires(1) = Worksheets("Équipements").Range("k14")
Destinataires(2) = TextBox3.Value
Sujet = "Bon de travail"

ThisWorkbook.Sheets("BT électronique").Copy 'ici je pourrait aussi prendre la valeur de la cellule G2
ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception
ActiveWorkbook.Close False

Cependant, je reçois toujours le fichier avec le nom Classeur1. Est-il possible de recevoir ce fichier avec comme nom de ficher la valeur qui apparait dans la cellule G2 du classeur1 ou de la cellule dernière cellule non vide de mon fichier d'origine ?

Merci

 

[Lone-wolf]

Re : Code pour envoi par mail mais changer nom fichier envoyé

Bonsoir Cougar,

Il faut mettre ceci avant le code d'envois

Sub Sauvegarde()
Dim fichier As String

'fichier = "C:\Cougar\" &  Sheets("Feuil1").Range("g2")
fichier = ThisWorkbook.Path & "\" & Sheets("Feuil1").Range("g2")    'si dans le même dossier

'xlOpenXMLWorkbookMacroEnabled = .xlsm / xlOpenXMLWorkbook = .xlsx / xlExcel8 = .xls
ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Sheets("Feuil1").DrawingObjects.Delete
End Sub
 
'------------------------------------------------------
.Attachments.Add Chemin & Nom, si c'est avec outlook.

A+

 

[Cougar]

Re : Code pour envoi par mail mais changer nom fichier envoyé

Bonjour Lone-wolf,

Je le code d'erreur : 1004 à cette ligne ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

J'ai placé la ligne suivante : Application.DisplayAlerts = False avant espérant corriger le tout mais sans succès.

J'utilise Outlook pour l'envoi.

Merci.

 

[Lone-wolf]

Re : Code pour envoi par mail mais changer nom fichier envoyé

Re Cougar,

essaie comme ceci:

Sub Envoi_Mail()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim StrBody As String
Dim fichier, nom As String

'Activer Référence Microsoft Outlook 14.0 Object Library


nom = Sheets("Feuil1").Range("g2") & ".xlsx"
'fichier = "C:\Cougar\" &  nom

fichier = ThisWorkbook.Path & "\" & nom   'si dans le même dossier

'xlOpenXMLWorkbookMacroEnabled = .xlsm / xlOpenXMLWorkbook = .xlsx / xlExcel8 = .xls
ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Sheets("Feuil1").DrawingObjects.Delete

Application.Wait (Now + TimeValue("00:00:01"))
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)

StrBody = "Bonjour Monsieur," & vbCrLf & "Vous avez un nouveau message !"

 With olMail
      .To = ""
      .CC = ""
      .Subject = "Message rappel"
      .Body = StrBody
      .Attachments.Add fichier
      .Display
   End With

    Set olMail = Nothing
    Set olApp = Nothing
End Sub

A+

 

[Cougar]

Re : Code pour envoi par mail mais changer nom fichier envoyé

Bonjour Lone-wolf,

Malgré les modifs ça ne fonctionne toujours pas. Donc, comme dernière tentative le code utilisé.

Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim StrBody As String
Dim fichier, nom As String

'Activer Référence Microsoft Outlook 14.0 Object Library
' je ne trouve pas la Référence Microsoft Outlook 14.0 Object Library

nom = Sheets("Feuil1").Range("g2") & ".xlsx"

fichier = ThisWorkbook.Path & "\" & nom

ActiveWorkbook.SaveAs Filename:=fichier, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

Sheets("Feuil1").DrawingObjects.Delete

'Destinataires(1) = Worksheets("Équipements").Range("k14")
Destinataires(2) = TextBox3.Value
Sujet = "Bon de travail"

Application.Wait (Now + TimeValue("00:00:01"))
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)

StrBody = "Bonjour," & vbCrLf & "Voici une copie de votre BT #" '& nom (= Sheets("Feuil1").Range("g2") & ".xlsx")

With olMail
.To = TextBox3.Value
.CC = ""
.Subject = "Copie de votre demande don de travail"
.Body = StrBody
.Attachments.Add fichier
.Display
End With

Set olMail = Nothing
Set olApp = Nothing


ThisWorkbook.Sheets("BT électronique").Copy
ActiveWorkbook.SendMail Destinataires, Sujet, AccuseReception
ActiveWorkbook.Close False

Merci

 

[Lone-wolf]

Re : Code pour envoi par mail mais changer nom fichier envoyé

Re,,

prend juste la Macro que j'ai mis, sans rien ajouter d'autres. J'ai testé . Ton classeur principal doit être dans un dossier ; ensuite exécute la Macro.


À+

 

[Cougar]

Re : Code pour envoi par mail mais changer nom fichier envoyé

Résolu. Merci