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
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
A voir également:
- Macro
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro word - Guide
- Macro logiciel - Télécharger - Organisation
- Macro recorder - Télécharger - Confidentialité
- Telecharger macro nblettre.xla - Forum Bureautique
3 réponses
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
20 août 2021 à 11:24
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
voilà ton PDF est dans le même dossier que ton classeur
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
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
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é :(
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
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
23 août 2021 à 08:02
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
@+ Le Pivert
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
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
Modifié le 24 août 2021 à 21:06
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.
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
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
>
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
24 août 2021 à 21:43
Envoyer sans Outlook:
https://www.commentcamarche.net/faq/36411-vb6-vba-envoi-mail-avec-l-objet-cdo
Voilà
https://www.commentcamarche.net/faq/36411-vb6-vba-envoi-mail-avec-l-objet-cdo
Voilà
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
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
24 août 2021 à 22:37
24 août 2021 à 22:37
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?
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
>
Fenouilleverte
Messages postés
31
Date d'inscription
mercredi 4 août 2021
Statut
Membre
Dernière intervention
9 novembre 2023
Modifié le 25 août 2021 à 11:04
Modifié le 25 août 2021 à 11:04
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:
il faudra adapter cette ligne:
et mettre dans le bouton ce code
Voilà
@+ Le Pivert
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
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
23 août 2021 à 22:39
Wow, milles merci!! C'est en plein ce que j'ai besoin. merci