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. Wow, milles merci!! C'est en plein ce que j'ai besoin. merci
    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. 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