Macro

Bonjour,

J'ai un tableau Excel que je veux que les gens complètent et me retournent. Pour se faire, je veux qu'ils cliquent sur le bouton que j'ai créé "Cliquez pour envoyer...". Pour l'instant, j'ai réussi à faire une macro pour qu'un message me soit envoyé cependant je ne sais pas comment faire pour que le fichier qu'ils viennent de compléter soit joint au courriel automatiquement. Ça peut être le fichier Excel ou un PDF, ça ne me dérange pas, l'important c'est que je recoive leur commande. De plus, dans le message, est-ce possible que leur nom qui est dans la cellule B3 soit écrit à la fin du message, histoire que je vois qui me l'envoie et que leur adresse qui est dans la cellule F3 se retrouve dans CC du message?

Merci beaucoup, voici le lien de mon fichier.

https://www.cjoint.com/c/KHtrbYGNT0x

3 réponses

  1. Contributeur
    Bonjour,

    voir ceci:

    https://excel-malin.com/codes-sources-vba/envoyer-un-email-avec-excel/

    ce qui donne pour ton cas, ce code à mettre dans un module et a associer à un bouton:

    allez dans outils-Référence et cochez Microsoft Outlook xxx Object Library

    Option Explicit
    Sub TestEnvoiEmail_Variables()
    'par Excel-Malin.com ( https://excel-malin.com )
    'allez dans outils-Référence et cochez Microsoft Outlook xxx Object Library
    'définition des variables
    Dim MonSujet As String
    Dim MonDestinataire As String
    Dim MonContenu As String
    Dim MaPieceJointe As String
     Dim sFilename As String 'Nom du fichier
    Dim sRep As String 'Répertoire de sauvegarde
    Dim LaDate$, Nom$, Rep$ 'Déclaration des variables
    LaDate = Format(Now, "yyyy_mm_dd_") & Format(Time, "hh_mm_") 'formatage de la date et heure
    Nom = Range("B3").Value 'Nom de l'onglet à entregistrer
    sRep = ThisWorkbook.Path & "\" 'Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
     sFilename = Nom & "_" & LaDate & ".pdf" 'Nom du fichier
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & sFilename, _
     Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
     OpenAfterPublish:=False
    'attribution des valeurs aux variables
    MonSujet = "Demande d'achats à faire"
    MonDestinataire = Range("F3").Value
    MonContenu = "Bonjour," & vbNewLine & vbNewLine & _
                  "Voici ma demande d'achat." & vbNewLine & _
                  Range("B3").Value & vbNewLine & _
                  "Merci"
    MaPieceJointe = sRep & sFilename
        
        'test envoi de l'email
            Call EnvoyerEmail(MonSujet, MonDestinataire, MonContenu, MaPieceJointe)
    
    MsgBox "Envoi réussi..."
    End Sub
    Sub EnvoyerEmail(ByVal Sujet As String, ByVal Destinataire As String, ByVal ContenuEmail As String, Optional ByVal PieceJointe As String)
    'par Excel-Malin.com ( https://excel-malin.com )
    
    On Error GoTo EnvoyerEmailErreur
    
    'définition des variables
    Dim oOutlook As Outlook.Application
    Dim WasOutlookOpen As Boolean
    Dim oMailItem As Outlook.MailItem
    Dim Body As Variant
    
    Body = ContenuEmail
    
        'vérification si le Contenu du mail n'est pas vide. Si oui, email n'est pas envoyé. Si vous voulez pouvoir envoyer les email vides, mettez en commentaire les 4 lignes de code qui suivent.
        If (Body = False) Then
            MsgBox "Mail non envoyé car vide", vbOKOnly, "Message"
            Exit Sub
           End If
        
        'préparer Outlook
        PreparerOutlook oOutlook
        Set oMailItem = oOutlook.CreateItem(0)
        
        'création de l'email
        With oMailItem
            .To = Destinataire
            .Subject = Sujet
            
            'CHOIX DU FORMAT
            '----------------------
            'email formaté comme texte
                .BodyFormat = olFormatRichText
                .Body = Body
                
                'OU
                
            'email formaté comme HTML
                '.BodyFormat = olFormatHTML
                '.HTMLBody = "<html><p>" & Body & "</p></html>"
            '----------------------
            
            If PieceJointe <> "" Then .Attachments.Add PieceJointe
    
           .Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
           .Save      '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
           .Send      '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
        End With
        
       'nettoyage...
        If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
        If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
        
       Exit Sub
    
    EnvoyerEmailErreur:
        If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
        If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
      
        MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
    End Sub
    
    Private Sub PreparerOutlook(ByRef oOutlook As Object)
    'par Excel-Malin.com ( https://excel-malin.com )
    
    '------------------------------------------------------------------------------------------------
    'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
    '------------------------------------------------------------------------------------------------
    On Error GoTo PreparerOutlookErreur
    
    
    On Error Resume Next
        'vérification si Outlook est ouvert
        Set oOutlook = GetObject(, "Outlook.Application")
        
        If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
            Err.Clear
            Set oOutlook = CreateObject("Outlook.Application")
        Else    'si Outlook est ouvert, l'instance existante est utilisée
            Set oOutlook = GetObject("Outlook.Application")
            oOutlook.Visible = True
        End If
        Exit Sub
    
    PreparerOutlookErreur:
        MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
    End Sub
    


    voilà ton PDF est dans le même dossier que ton classeur
    0
    1. Bonjour Le Pivert,
      Merci pour ton temps mais je suis très très novice donc j'ai copié tes codes dans mon fichier mais ça ne fonctionne pas. ESt-ce que je dois enlever tout le texte en vert ? désolé :(
      0
      1. Contributeur
        il suffit de faire Alt F11 pour accéder à l'éditeur

        Ensuite insérer un module et coller le code

        Puis ​allez dans Outils-Référence et cochez Microsoft Outlook xxx Object Library

        et mettre dans le bouton ce code

        Option Explicit
        Private Sub CommandButton1_Click()
        TestEnvoiEmail_Variables
        End Sub
        


        @+ Le Pivert
        0
      2. @cs_Le PivertWow, milles merci!! C'est en plein ce que j'ai besoin. merci

        Dernier chose, si j'ai des gens qui utilise Outlook 365 ça ne fonctionne pas. Est-ce qu'il y aurait quelque chose que je pourrais faire? Merci à l'avance.
        0
      3. Contributeur
        @FenouilleverteEnvoyer sans Outlook:

        https://www.commentcamarche.net/faq/36411-vb6-vba-envoi-mail-avec-l-objet-cdo

        Voilà
        0
      4. @cs_Le PivertEst-ce que si je copie ces codes ça veut dire que les employés qui utilisent Outlook, ça va marcher comme ma première version et ceux qui utilise Outlook 365 également?
        0
      5. Contributeur
        @FenouilleverteIl faut mettre un 2ème bouton pour Outlook 365!

        Faire Alt F11 pour accéder à l'éditeur

        Ensuite insérer un nouveau module pour y coller ce code:

        Option Explicit
        Option Compare Text
        Sub EnvoiMailCDO()
        Dim mMessage As Object
        Dim mConfig As Object
        Dim mChps
        Dim Fichier As Variant
        Dim sFilename As String 'Nom du fichier
        Dim sRep As String 'Répertoire de sauvegarde
        Dim LaDate$, Nom$, Rep$ 'Déclaration des variables
        LaDate = Format(Now, "yyyy_mm_dd_") & Format(Time, "hh_mm_") 'formatage de la date et heure
        Nom = Range("B3").Value 'Nom de l'onglet à entregistrer
        sRep = ThisWorkbook.Path & "\" 'Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
         sFilename = Nom & "_" & LaDate & ".pdf" 'Nom du fichier
         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & sFilename, _
         Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
         OpenAfterPublish:=False
            Set mConfig = CreateObject("CDO.Configuration")
            
            mConfig.Load -1
            Set mChps = mConfig.Fields
            Sheets("EnvoiMail").Select ' adapter le nom de la feuille
            With mChps
                .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
                'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr"
        
        
                'En principe, 25 fonctionne avec tout les serveurs.
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
                
                'Vous pouvez essayer sans ces trois lignes
                'Mais si votre serveur demande une authentification,
                'If [E6].Value <> "" Then
                   ' .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
                   ' .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = [E6].Value
                   ' .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = [E16].Value
               ' End If
                'Si votre serveur demande une connexion sûre (SSL)
                'If [E14].Value <> "non" Then
                    '.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "True"
                'End If
                .Update
            End With
            
            Set mMessage = CreateObject("CDO.Message")
            With mMessage
            Set .Configuration = mConfig
                .To = Range("F3").Value 'destinataire
                .From = Range("F4").Value 'expediteur ' a adapter
                .Subject = "Demande d'achats à faire"
                .TextBody = "Bonjour," & vbNewLine & vbNewLine & _
                      "Voici ma demande d'achat." & vbNewLine & _
                      Range("B3").Value & vbNewLine & _
                      "Merci"
                'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
                .AddAttachment sRep & sFilename 'Chemin et nom complet du fichier à joindre
                .Send
            End With
            MsgBox "Message envoyé"
            Set mMessage = Nothing
          
            'Libère les ressources
            Set mConfig = Nothing
            Set mChps = Nothing
            
        End Sub
        


        il faudra adapter cette ligne:

         'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
                .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr"
           'et celle ci:
        Sheets("EnvoiMail").Select ' adapter le nom de la feuille
        


        et mettre dans le bouton ce code

        Option Explicit
        Private Sub CommandButton1_Click()
        TestEnvoiEmail_Variables
        End Sub
        Private Sub CommandButton2_Click()
            EnvoiMailCDO
        End Sub


        Voilà

        @+ Le Pivert
        0
    2. Wow, milles merci!! C'est en plein ce que j'ai besoin. merci
      0