XL 2016 Envoi mail fichier Excel renommer

FS69 · 10 Août 2022

Bonjour,

Je suis novice en vba et il y a quelques mois j'avais récupéré la macro ci-dessous que j'ai pu adapter à mon besoin et qui fonctionne parfaitement.

Aujourd'hui, je souhaiterais réadapter celle-ci afin d'une part : envoyer le classeur au format Excel et d'autre part sélectionner d'autres cellules renommer le fichier avant envoi et pouvoir en choisir d'autre dans l'objet du mail.

Or, en retirant les lignes relatives à la conversion en PDF ou lorsque je modifie les références de cellule dans l'objet j'ai un message d'erreur

Pouvez vous m'aider ?

Code :

Sub SendWithMail()
' Nécessite la référence : Microsoft Outlook 1x Object Library
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurFile As String
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
' "C:\Users\Thierry\AppData\Local\Temp\MaFeuille.pdf "
CurFile = ThisWorkbook.Path & "\" & "AAA.pdf"
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With olMail
.To = "test.test@blabla.fr"
.CC = ""
.Subject = "#" & Range("Client!H1").Value & "#" & "Décision" & " " & Range("Produits!B3").Value & " " & Range("Mon Besoin!D3").Value
.Body = "Bonjour," & vbNewLine & vbNewLine & _
"Vous trouverez ci-joint le fichier Excel" & vbNewLine & vbNewLine & _
"Cordialement"
.Attachments.Add CurFile
'.Attachments.Add "c:\My Documents\book.doc"
.Display '.Send
End With
MsgBox "Merci de vérifier que le message apparait dans -messages envoyés- dans votre messagerie OUTLOOK."
1
' Effacer les variables objets
Set olMail = Nothing
Set olApp = Nothing
Do While fich <> ""
Loop
Kill ActiveWorkbook.Path & "\" & "*.pdf" ' Là ou détruit le fichier créé

End sub

fanch55 · 12 Août 2022

Bonjour,
A tester :

VB:

Sub SendWithMail()
    ThisWorkbook.Save
    With CreateObject("Outlook.Application").CreateItem(olMailItem)
        .To = "test.test@blabla.fr"
        .CC = ""
        .Subject = "#" & Range("Client!H1").Value & _
                   "#" & "Décision" & " " & Range("Produits!B3").Value & _
                   " " & Range("'Mon Besoin'!D3").Value
        .Body = "Bonjour," & vbLf & vbLf & _
                "Vous trouverez ci-joint le fichier Excel" & vbNewLine & vbNewLine & _
                "Cordialement"
        .Attachments.Add ThisWorkbook.FullName
    .Display '.Send
    End With
    MsgBox "Merci de vérifier que le message apparait dans" & vbLf & _
           "- messages envoyés -" & vbLf & _
           "dans votre messagerie OUTLOOK."
End Sub

FS69 · 12 Août 2022

Bonjour, merci de votre retour,
Malheureusement j'ai toujours une anomalie sur les lignes :
.Subject = "#" & Range("Client!H1").Value & _
"#" & "Décision" & " " & Range("Produits!B3").Value & _
" " & Range("'Mon Besoin'!D3").Value

Cela vient de l'espace dans la feuille "Mon Besoin", je vais donc modifier le nom de cette feuille
Pourriez vous me dire comment je peux avoir le même mon fichier excel renommer comme mon sujet de mail ?

fanch55 · 12 Août 2022

FS69 à dit:
Malheureusement j'ai toujours une anomalie sur les lignes :
.Subject = "#" & Range("Client!H1").Value & _
"#" & "Décision" & " " & Range("Produits!B3").Value & _
" " & Range("'Mon Besoin'!D3").Value

Ce n'est pas l'espace dans "Mon besoin", peut-être en y a-t-il un également en début ou fin ...

FS69 à dit:
Pourriez vous me dire comment je peux avoir le même mon fichier excel renommer comme mon sujet de mail ?

VB:

Sub SendWithMail()
Dim Copie As String
    ThisWorkbook.Save
    With CreateObject("Outlook.Application").CreateItem(olMailItem)
        .To = "test.test@blabla.fr"
        .CC = ""
        .Subject = "#" & Range("Client!H1").Value & _
                   "#" & "Décision" & " " & Range("Produits!B3").Value & _
                   " " & Range("'Mon Besoin'!D3").Value
        Copie = ThisWorkbook.Path & "\" & .Subject & ".xlsm"
        ThisWorkbook.SaveCopyAs Copie
        .Body = "Bonjour," & vbLf & vbLf & _
                "Vous trouverez ci-joint le fichier Excel" & vbNewLine & vbNewLine & _
                "Cordialement"
        .Attachments.Add Copie
        Kill Copie
    .Display '.Send
    End With
    MsgBox "Merci de vérifier que le message apparait dans" & vbLf & _
           "- messages envoyés -" & vbLf & _
           "dans votre messagerie OUTLOOK."

End Sub

FS69 · 16 Août 2022

fanch55 à dit:

Ce n'est pas l'espace dans "Mon besoin", peut-être en y a-t-il un également en début ou fin ...

VB:

Sub SendWithMail()
Dim Copie As String
    ThisWorkbook.Save
    With CreateObject("Outlook.Application").CreateItem(olMailItem)
        .To = "test.test@blabla.fr"
        .CC = ""
        .Subject = "#" & Range("Client!H1").Value & _
                   "#" & "Décision" & " " & Range("Produits!B3").Value & _
                   " " & Range("'Mon Besoin'!D3").Value
        Copie = ThisWorkbook.Path & "\" & .Subject & ".xlsm"
        ThisWorkbook.SaveCopyAs Copie
        .Body = "Bonjour," & vbLf & vbLf & _
                "Vous trouverez ci-joint le fichier Excel" & vbNewLine & vbNewLine & _
                "Cordialement"
        .Attachments.Add Copie
        Kill Copie
    .Display '.Send
    End With
    MsgBox "Merci de vérifier que le message apparait dans" & vbLf & _
           "- messages envoyés -" & vbLf & _
           "dans votre messagerie OUTLOOK."

End Sub

Merci beaucoup pour votre réponse qui réalise ce que je souhaites si mes cellules référencées sont vides , dès que je renseigne quelques choses voici ce que j'ai :

fanch55 · 16 Août 2022

FS69 à dit:
Merci beaucoup pour votre réponse qui réalise ce que je souhaites si mes cellules référencées sont vides , dès que je renseigne quelques choses voici ce que j'ai :
Regarde la pièce jointe 1147390

Un nom de fichier ne peut contenir une date au format dd/mm/aaaa
Correction du code ;

VB:

Sub SendWithMail()
Dim Copie As String
    Select Case True
        Case IsVide(Range("Client!H1")):        DoEvents
        Case IsVide(Range("Produits!B3")):      DoEvents
        Case IsVide(Range("'Mon Besoin'!D3")):  DoEvents
        Case Else:
            ThisWorkbook.Save
            With CreateObject("Outlook.Application").CreateItem(olMailItem)
                .To = "test.test@blabla.fr"
                .CC = ""
                .Subject = Replace("#" & Range("Client!H1").Value & _
                                   "#" & "Décision" & " " & Range("Produits!B3").Value & _
                                   " " & Range("'Mon Besoin'!D3").Value, _
                                   "/", "_")
                On Error GoTo Exit_Error
                Copie = ThisWorkbook.Path & "\" & .Subject & ".xlsm"
                ThisWorkbook.SaveCopyAs Copie
                
                .Body = "Bonjour," & vbLf & vbLf & _
                        "Vous trouverez ci-joint le fichier Excel" & vbLf & vbLf & _
                        "Cordialement"
                .Attachments.Add Copie
                Kill Copie
            .Display '.Send
            End With
            MsgBox "Merci de vérifier que le message apparait dans" & vbLf & _
                   "- messages envoyés -" & vbLf & _
                   "dans votre messagerie OUTLOOK."
    End Select
Exit Sub

Exit_Error:
    MsgBox "Erreur probable dans le nom de fichier" & vbLf & _
            Err.Description, vbCritical, "Abandon"

End Sub
Function IsVide(Rng As Range) As Boolean
    IsVide = Rng.Value = ""
    If IsVide Then MsgBox Rng.AddressLocal(external:=True) & " vide !!!", vbCritical, "Abandon"
End Function

FS69 · 18 Août 2022

fanch55 à dit:

Un nom de fichier ne peut contenir une date au format dd/mm/aaaa
Correction du code ;

VB:

Sub SendWithMail()
Dim Copie As String
    Select Case True
        Case IsVide(Range("Client!H1")):        DoEvents
        Case IsVide(Range("Produits!B3")):      DoEvents
        Case IsVide(Range("'Mon Besoin'!D3")):  DoEvents
        Case Else:
            ThisWorkbook.Save
            With CreateObject("Outlook.Application").CreateItem(olMailItem)
                .To = "test.test@blabla.fr"
                .CC = ""
                .Subject = Replace("#" & Range("Client!H1").Value & _
                                   "#" & "Décision" & " " & Range("Produits!B3").Value & _
                                   " " & Range("'Mon Besoin'!D3").Value, _
                                   "/", "_")
                On Error GoTo Exit_Error
                Copie = ThisWorkbook.Path & "\" & .Subject & ".xlsm"
                ThisWorkbook.SaveCopyAs Copie
               
                .Body = "Bonjour," & vbLf & vbLf & _
                        "Vous trouverez ci-joint le fichier Excel" & vbLf & vbLf & _
                        "Cordialement"
                .Attachments.Add Copie
                Kill Copie
            .Display '.Send
            End With
            MsgBox "Merci de vérifier que le message apparait dans" & vbLf & _
                   "- messages envoyés -" & vbLf & _
                   "dans votre messagerie OUTLOOK."
    End Select
Exit Sub

Exit_Error:
    MsgBox "Erreur probable dans le nom de fichier" & vbLf & _
            Err.Description, vbCritical, "Abandon"

End Sub
Function IsVide(Rng As Range) As Boolean
    IsVide = Rng.Value = ""
    If IsVide Then MsgBox Rng.AddressLocal(external:=True) & " vide !!!", vbCritical, "Abandon"
End Function

Merci beaucoup, ça marche parfaitement

Effectuez une recherche sur Excel Downloads...

XL 2016 Envoi mail fichier Excel renommer

FS69

XLDnaute Nouveau

fanch55

fanch55

XLDnaute Barbatruc

FS69

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

FS69

XLDnaute Nouveau

fanch55

XLDnaute Barbatruc

FS69

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums