Macro

Fermé

Fenouilleverte Messages postés 31 Date d'inscription mercredi 4 août 2021 Statut Membre Dernière intervention 9 novembre 2023 - 19 août 2021 à 19:06
Fenouilleverte Messages postés 31 Date d'inscription mercredi 4 août 2021 Statut Membre Dernière intervention 9 novembre 2023 - 16 sept. 2021 à 19:42

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

A voir également:

Macro
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Macro recorder - Télécharger - Confidentialité
Macro souris ✓ - Forum Windows

3 réponses

Réponse 1 / 3

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
20 août 2021 à 11:24

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

Réponse 2 / 3

Fenouilleverte Messages postés 31 Date d'inscription mercredi 4 août 2021 Statut Membre Dernière intervention 9 novembre 2023
23 août 2021 à 02:18

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é :(

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
23 août 2021 à 08:02

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

Fenouilleverte Messages postés 31 Date d'inscription mercredi 4 août 2021 Statut Membre Dernière intervention 9 novembre 2023 > cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024
Modifié le 24 août 2021 à 21:06

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.

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728 > Fenouilleverte Messages postés 31 Date d'inscription mercredi 4 août 2021 Statut Membre Dernière intervention 9 novembre 2023
24 août 2021 à 21:43

Envoyer sans Outlook:

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

Voilà

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?

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

Réponse 3 / 3

Fenouilleverte Messages postés 31 Date d'inscription mercredi 4 août 2021 Statut Membre Dernière intervention 9 novembre 2023
23 août 2021 à 22:39

Wow, milles merci!! C'est en plein ce que j'ai besoin. merci

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro

Copie automatique tableau Excel sans macro

recup couleur de cellule sans macro

Lien de téléchargement de nbLettre.xla

tri automatque sur excel sans créer de macro

Discussions similaires

Newsletters