Menu

Envoi mail à partir feuille Excel 2003 [Résolu]

jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 25 sept. 2017 à 10:13 - Dernière réponse : f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention
- 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.


Afficher la suite 

122 réponses

Répondre au sujet
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 25 sept. 2017 à 11:03
Commenter la réponse de f894009
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 25 sept. 2017 à 18:44
0
Utile
1
Bonjour f894009,
N'aurais-tu le lien en français stp ?
En te remerciant.
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 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
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 26 sept. 2017 à 09:51
0
Utile
1
Je te remercie f894009
Bonne journée à toi
Je reviendrais si problème si tu me le permet
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 26 sept. 2017 à 10:39
Re,

Ok, pas de probleme
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 3 oct. 2017 à 13:58
0
Utile
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 :
http://www.cjoint.com/c/GJdl5C3DRHO
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 3 oct. 2017 à 15:04
0
Utile
4
Re
Je viens d'y aller.
Merci pour ce rappel, sympa de ta part.
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 :
http://www.commentcamarche.net/forum/affich-34888882-envoi-mail-a-partir-feuille-excel-2003#6
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention > lucien - 3 oct. 2017 à 15:31
Bonjour,
Jean300
Petit probleme, avec votre fichier, pas possible clic droit sur les boutons feuilles!!!!!!!!!!!!
lucien > f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 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é).
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention > lucien - 3 oct. 2017 à 15:45
Re,
Ok

suite:

envoi par outlook ou cdo ?????
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - Modifié par jean300 le 3/10/2017 à 16:29
0
Utile
1
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
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 3 oct. 2017 à 16:45
Re,

mais la secrétaire
Elle a quoi, cette personne???
Elle a un Office au moins ????
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 3 oct. 2017 à 17:27
0
Utile
1
Re,
Elle a sur son ordi Office 2003
et sur un autre Office 2013
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 3 oct. 2017 à 20:15
Re,
Ben, y a forcément Outlook, comprends pas pourquoi CDO
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 3 oct. 2017 à 20:19
0
Utile
1
Re,
Sur l'ordi office 2003 il n'y a pas Outloock.
En faite elle a Word, Excel et Powerpoint.
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 4 oct. 2017 à 07:11
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

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


A+
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 4 oct. 2017 à 09:38
0
Utile
1
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.
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 4 oct. 2017 à 11:13
Re,
En effet, j'ai teste et pas marche, je regarde car j'ai d'autres fichiers cdo
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 4 oct. 2017 à 12:45
0
Utile
1
Pas de souci mon ami, j'ai tout mon temps.
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 4 oct. 2017 à 17:22
Re,

Il y aurait un petit probleme avec le serveur smtp Gmail, pas moyen de se connecter avec CDO!!!!!!!
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 4 oct. 2017 à 18:46
0
Utile
1
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
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 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!!!!!!
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 5 oct. 2017 à 09:57
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 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 .....
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 5 oct. 2017 à 10:21
0
Utile
1
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é.
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 5 oct. 2017 à 11:00
Re,

Pas possible de remettre outlook sur les PC ou il a disparu?????
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 5 oct. 2017 à 12:34
0
Utile
2
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
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 5 oct. 2017 à 13:22
Re,

Non, tous les parametres sont renseignes et le serveur ne veut pas repondre.........
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention > f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 5 oct. 2017 à 14:29
Re,
Si j'utilise le serveur smtp free, ca marche donc, vient bien de smtp gmail
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 5 oct. 2017 à 15:36
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 5 oct. 2017 à 17:25
Re,
Deja essaye, pas mieux................!
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 5 oct. 2017 à 18:38
0
Utile
1
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
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 5 oct. 2017 à 20:23
Re,
Oui, mais pareil déjà vu et pas marche, par contre vous pouvez essayer.....
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 5 oct. 2017 à 20:57
0
Utile
1
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.
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 6 oct. 2017 à 06:47
Bonjour,

Si, il y a un message mais as que...!!
Quelle erreur avez-vous ?
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 6 oct. 2017 à 09:29
0
Utile
1
Bonjour mon ami,
.Send se surligne en jaune
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 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
Commenter la réponse de jean300
jean300 129 Messages postés jeudi 11 août 2016Date d'inscription 8 février 2018 Dernière intervention - 6 oct. 2017 à 09:33
0
Utile
1
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
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 6 oct. 2017 à 10:33
Re,
Desole, en effet pas d'erreur, mais pas marche aucun @mail recu!!!
Commenter la réponse de jean300
0
Utile
1
Re,
Je viens de voir ceci, je ne sais si ça pourra t'aider ?
http://www.cjoint.com/c/GJgnMR8e8MO
f894009 12716 Messages postés dimanche 25 novembre 2007Date d'inscription 23 février 2018 Dernière intervention - 6 oct. 2017 à 17:22
Re,
Non, c'est toujours les meme codes et donc pas marche
Merci quand meme
Commenter la réponse de jean300
Envoi mail à partir feuille Excel 2003 - page 2