Macro

Fenouilleverte Messages postés 32 Statut Membre -  
Fenouilleverte Messages postés 32 Statut Membre -
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.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  2. Fenouilleverte Messages postés 32 Statut Membre
     
    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. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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. Fenouilleverte Messages postés 32 Statut Membre > cs_Le Pivert Messages postés 8437 Statut Contributeur
       
      Wow, 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. cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > Fenouilleverte Messages postés 32 Statut Membre
       
      Envoyer sans Outlook:

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

      Voilà
      0
    4. Fenouilleverte Messages postés 32 Statut Membre > cs_Le Pivert Messages postés 8437 Statut Contributeur
       
      Est-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. cs_Le Pivert Messages postés 8437 Statut Contributeur 730 > Fenouilleverte Messages postés 32 Statut Membre
       
      Il 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
  3. Fenouilleverte Messages postés 32 Statut Membre
     
    Wow, milles merci!! C'est en plein ce que j'ai besoin. merci
    0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses
recup couleur de cellule sans macro
magouero -
JvDo -

7 réponses
convertir des chiffres en lettres avec une unique formule
FOUAD_9000 -
Mike-31 -

34 réponses