Envoi mail à partir feuille Excel 2003

Résolu/Fermé
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 - 25 sept. 2017 à 10:13
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 8 févr. 2018 à 15:45
Bonjour,
Auriez-vous un modèle pour envoyer un mail à destinataires multiple via une feuille Excel svp.
E vous remerciant.


A voir également:

77 réponses

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
25 sept. 2017 à 11:03
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
25 sept. 2017 à 18:44
Bonjour f894009,
N'aurais-tu le lien en français stp ?
En te remerciant.
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
26 sept. 2017 à 07:45
Bonjour,

Non, pas en francais, desole. Un exemple de code que j'ai fait pour un gars sur CCM.

' Touche de raccourci du clavier: Ctrl+e
' Envoidu_MailAutomatique Macro
Sub Envoidu_EMailAutomatique()
    On Error Resume Next
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim Plage_DL As Range       'Plage de date a tester
    Dim Societe As String
    Dim AdresseEMail As String
    Dim cel As Range

    With Worksheets("FEUILLE DE TRAVAIL VIERGE")
        Set Plage_DL = .Range("G57:G64")        'plage de dates a tester
        Societe = .Range("C12")                          'societe
        AdresseEMail = .Range("D54")                '@Mail
    End With
    'initialisation contenu corps de message
    Contenu = ""
    'boucle plage Date de fin de validité a date-10jours!!!!!!
    For Each cel In Plage_DL
        If cel <= Date - 10 And IsDate(cel) And cel.Offset(, 4) = Empty Then
            cel.Offset(, 4).Value = Date        'ecriture date envoi @Mail
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            'contenu message
            Contenu = Contenu & cel.Offset(, -6).Value & " Date Fin: " & cel.Value & vbNewLine
        End If
    Next
    'Corps Message
    strbody = Contenu & vbTab
    'parametrage de l'envoi
    With OutMail
        .To = AdresseEMail
        .CC = ""          ' a modifier si besoin
        .BCC = ""
        .Subject = "Date de fin validité justificatifs pour Societe: " & Societe
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        'pour voir @Mail et validation envoi
        .Display
        'Envoi sans visualisation: mettre ' devant .Display et enlever le ' devant .Send
        '.Send
    End With
    'attente envoi @Mail par Outlook
    'Application.Wait Application.Wait(Now + TimeValue("0:00:01"))
    Set OutMail = Nothing
    Set OutApp = Nothing
    On Error GoTo 0
End Sub
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
26 sept. 2017 à 09:51
Je te remercie f894009
Bonne journée à toi
Je reviendrais si problème si tu me le permet
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
26 sept. 2017 à 10:39
Re,

Ok, pas de probleme
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
3 oct. 2017 à 13:58
Bonjour cher ami(s)
Après avoir remanier mon projet de fond en comble, je ne m'en sors pas au sujet de l'envoi de mail.
J'espère que les quelques notations mises vous aideront à mieux cerner ma demande.
Le fichier :
https://www.cjoint.com/c/GJdl5C3DRHO
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
3 oct. 2017 à 15:04
Re
Je viens d'y aller.
Merci pour ce rappel, sympa de ta part.
0
Merci pour ta réponse ; j'ai supprimé mon message précédent et
j'espère que f894009 pourra répondre à ta dernière demande :
https://forums.commentcamarche.net/forum/affich-34888882-envoi-mail-a-partir-feuille-excel-2003#6
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > lucien
3 oct. 2017 à 15:31
Bonjour,
Jean300
Petit probleme, avec votre fichier, pas possible clic droit sur les boutons feuilles!!!!!!!!!!!!
0
lucien > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
3 oct. 2017 à 15:40
Bonjour f894009,
Je viens d'essayer avec le fichier de jean300 ; pour pouvoir faire un clic droit
sur le bouton des feuilles, fais d'abord ceci : onglet Développeur, groupe
Contrôles, clique sur « Mode Création » (il doit être en orange = activé).
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > lucien
Modifié le 3 oct. 2017 à 15:50
Re,
Ok

suite:

envoi par outlook ou cdo ?????
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
Modifié le 3 oct. 2017 à 16:29
Bonjour f894009,
Heureux de te retrouver, merci beaucoup, j'apprécie hautement ton aide (si je peux appeler cela de l'aide) car tu vas faire tout le travail .
Pour simplifier, les deux types seront de mise, car le directeur à Outlook mais la secrétaire et ce sont ces deux seules personnes qui envoient les mails.
C'est vraiment pas simple. (peut être faudra-t-il 2 boutons)
- envoi via Outloock
- envoi via cdo
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié le 3 oct. 2017 à 17:13
Re,

mais la secrétaire
Elle a quoi, cette personne???
Elle a un Office au moins ????
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
3 oct. 2017 à 17:27
Re,
Elle a sur son ordi Office 2003
et sur un autre Office 2013
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
3 oct. 2017 à 20:15
Re,
Ben, y a forcément Outlook, comprends pas pourquoi CDO
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
3 oct. 2017 à 20:19
Re,
Sur l'ordi office 2003 il n'y a pas Outloock.
En faite elle a Word, Excel et Powerpoint.
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié le 4 oct. 2017 à 07:45
Bonjour,
Ok, je regarde la chose pour CDO partout

Exemple de code fait par Lermite22 de CCM, testez pour vous assurer du bon fonctionnement par rapport au serveurs SMTP suivant messageries des personnes qui enverrons ces @Mails

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


A+
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
4 oct. 2017 à 09:38
Bonjour f894009,
Je te remercie pour le travail effectué.
J'ai fais l'essaie que tu m'a demandé, j'ai eu un bug à cet endroit et j'ai mis une ' devant Send pour pouvoir continuer :
        'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
' .Send

End With
Set mMessage = Nothing

Mais rien n'est arrivé dans ma boîte mail.
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
4 oct. 2017 à 11:13
Re,
En effet, j'ai teste et pas marche, je regarde car j'ai d'autres fichiers cdo
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
4 oct. 2017 à 12:45
Pas de souci mon ami, j'ai tout mon temps.
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié le 4 oct. 2017 à 17:22
Re,

Il y aurait un petit probleme avec le serveur smtp Gmail, pas moyen de se connecter avec CDO!!!!!!!
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
4 oct. 2017 à 18:46
Bonsoir
Est-ce que ceci peut t'aider ?
Sub test()
MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
End Sub
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") ' pour la configuration de l'envoi
Dim strHTML

Set Config = Conf.Fields

' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
.Update

End With

'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1

With msg
Set .Configuration = Conf
.To = Dest
.cc = DestEnCopy
.FROM = Expediteur
.Subject = Objet
'

.HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
If Pj <> "" Then
splitPj = Split(Pj & ";", ";")

For IsplitPj = 0 To UBound(splitPj)
If Trim("" & splitPj(IsplitPj)) <> "" Then
.AddAttachment Trim("" & splitPj(IsplitPj))
doevents
End If
Next

End If
.Send 'envoi du message
doevents
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
End Sub
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
5 oct. 2017 à 08:11
Bonjour,

Ben, tous les codes que j'ai ne marche plus et celui que vous proposez idem, probleme de connection au serveur smtp de Gmail!!!!!!
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
5 oct. 2017 à 09:57
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
5 oct. 2017 à 10:19
Bonjour,

Merci, mais deja vu et ca marchait au moment ou j'ai recupere ces codes mais plus maintenant, alors .....
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
5 oct. 2017 à 10:21
Je t'en donne des soucis, désolé et merci pour tout ton travail.
Je te souhaite une bonne journée.
ps : je ne suis pas pressé.
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
5 oct. 2017 à 11:00
Re,

Pas possible de remettre outlook sur les PC ou il a disparu?????
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
5 oct. 2017 à 12:34
Re,
Hélas non car ils n'ont plus le CD et le directeur ne veut pas prêter son office 2013.
Mais le problème ne viendrait-il pas d'ici :
User
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
5 oct. 2017 à 13:22
Re,

Non, tous les parametres sont renseignes et le serveur ne veut pas repondre.........
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701 > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
5 oct. 2017 à 14:29
Re,
Si j'utilise le serveur smtp free, ca marche donc, vient bien de smtp gmail
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
5 oct. 2017 à 15:36
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
5 oct. 2017 à 17:25
Re,
Deja essaye, pas mieux................!
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
5 oct. 2017 à 18:38
Re,
J'ai trouvé ceci :
Sub EnvoiMailCDO()
'MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
MailEnvoi [E8].Value, [E14].Value <> "non", [E6].Value, [E16].Value, [E12].Value, 10, [E6].Value, [k6].Value, "", [K8].Value, [K10].Value, "" ' pour les pièce jointes "c:\Fichier1;c:\Fichier2;"
'MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
End Sub
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") ' pour la configuration de l'envoi
Dim strHTML

Set Config = Conf.Fields

' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
.Update
End With
'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1

With msg
Set .Configuration = Conf
.To = Dest
.cc = DestEnCopy
.FROM = Expediteur
.Subject = Objet
'
.HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
If Pj <> "" Then
splitPj = Split(Pj & ";", ";")

For IsplitPj = 0 To UBound(splitPj)
If Trim("" & splitPj(IsplitPj)) <> "" Then
.AddAttachment Trim("" & splitPj(IsplitPj))
End If
Next
End If
.Send 'envoi du message
End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing
End Sub
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
5 oct. 2017 à 20:23
Re,
Oui, mais pareil déjà vu et pas marche, par contre vous pouvez essayer.....
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
5 oct. 2017 à 20:57
Re,
J'ai essayer bloc à .Send 'envoi du message
Je pense que c'est parce que il n'y a pas de message.
Ne pipant pas un mot d'anglais, pas facile pour moi.
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié le 6 oct. 2017 à 07:20
Bonjour,

Si, il y a un message mais as que...!!
Quelle erreur avez-vous ?
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
6 oct. 2017 à 09:29
Bonjour mon ami,
.Send se surligne en jaune
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
6 oct. 2017 à 10:18
Re,
Oui, mais normalement y a une boite a message qui donne l'erreur !!!!
De mon cote, je regarde pour l'envoi via Outlook, vue que deux micros ont Outlook
0
jean300 Messages postés 374 Date d'inscription jeudi 11 août 2016 Statut Membre Dernière intervention 13 janvier 2020 14
6 oct. 2017 à 09:33
Re,
Le seul code qui va jusqu'au bout sans bug, mais pas de message reçu.
Sub EnvoiMailCDO2()     ' Pas de problème mais pas de mail reçu
'MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
MailEnvoi [E8].Value, [E14].Value <> "non", [E6].Value, [E16].Value, [E12].Value, 10, [E6].Value, [k6].Value, "", [K8].Value, [K10].Value, "" ' pour les pièce jointes "c:\Fichier1;c:\Fichier2;"
'MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
End Sub
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") ' pour la configuration de l'envoi
Dim strHTML

Set Config = Conf.Fields

' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
.Update

End With


'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1

With msg
Set .Configuration = Conf
.To = Dest
.cc = DestEnCopy
.FROM = Expediteur
.Subject = Objet
'

.HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
If Pj <> "" Then
splitPj = Split(Pj & ";", ";")

For IsplitPj = 0 To UBound(splitPj)
If Trim("" & splitPj(IsplitPj)) <> "" Then
.AddAttachment Trim("" & splitPj(IsplitPj))
End If
Next

End If
' .Send 'envoi du message

End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing

End Sub
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
Modifié le 6 oct. 2017 à 10:36
Re,
Desole, en effet pas d'erreur, mais pas marche aucun @mail recu!!!
0
Re,
Je viens de voir ceci, je ne sais si ça pourra t'aider ?
http://www.cjoint.com/c/GJgnMR8e8MO
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
6 oct. 2017 à 17:22
Re,
Non, c'est toujours les meme codes et donc pas marche
Merci quand meme
0