Envoi mail à partir feuille Excel 2003

Résolu
jean300 Messages postés 382 Statut Membre -  
f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
Auriez-vous un modèle pour envoyer un mail à destinataires multiple via une feuille Excel svp.
E vous remerciant.

77 réponses

  • 1
  • 2
  • 3
  • 4
Résumé de la discussion

Le problème est l'envoi d'un mail à plusieurs destinataires à partir d'une feuille Excel sous Windows. La discussion signale que le message est tronqué et que la solution dépend de la version d'Office et du client mail, avec des références à Outlook 2013 et à une éventuelle compatibilité avec Outlook 2007. Deux approches sont évoquées: l'envoi via Outlook et l'envoi via CDO, accompagnées d'erreurs liées à la boîte à messages. Des tests futurs prévoient de tester Outlook 2007 pour évaluer la faisabilité et la compatibilité des solutions proposées.

Bobot (l'IA à votre service)
  1. jean300 Messages postés 382 Statut Membre 14
     
    Bonjour f894009,
    N'aurais-tu le lien en français stp ?
    En te remerciant.
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
  2. jean300 Messages postés 382 Statut Membre 14
     
    Je te remercie f894009
    Bonne journée à toi
    Je reviendrais si problème si tu me le permet
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      Ok, pas de probleme
      0
  3. jean300 Messages postés 382 Statut Membre 14
     
    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
  4. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  5. jean300 Messages postés 382 Statut Membre 14
     
    Re
    Je viens d'y aller.
    Merci pour ce rappel, sympa de ta part.
    0
    1. lucien
       
      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
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > lucien
         
        Bonjour,
        Jean300
        Petit probleme, avec votre fichier, pas possible clic droit sur les boutons feuilles!!!!!!!!!!!!
        0
      2. lucien > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
         
        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
      3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > lucien
         
        Re,
        Ok

        suite:

        envoi par outlook ou cdo ?????
        0
  6. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      mais la secrétaire
      Elle a quoi, cette personne???
      Elle a un Office au moins ????
      0
  7. jean300 Messages postés 382 Statut Membre 14
     
    Re,
    Elle a sur son ordi Office 2003
    et sur un autre Office 2013
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      Ben, y a forcément Outlook, comprends pas pourquoi CDO
      0
  8. jean300 Messages postés 382 Statut Membre 14
     
    Re,
    Sur l'ordi office 2003 il n'y a pas Outloock.
    En faite elle a Word, Excel et Powerpoint.
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
  9. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      En effet, j'ai teste et pas marche, je regarde car j'ai d'autres fichiers cdo
      0
  10. jean300 Messages postés 382 Statut Membre 14
     
    Pas de souci mon ami, j'ai tout mon temps.
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      Il y aurait un petit probleme avec le serveur smtp Gmail, pas moyen de se connecter avec CDO!!!!!!!
      0
  11. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
  12. jean300 Messages postés 382 Statut Membre 14
     
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      Merci, mais deja vu et ca marchait au moment ou j'ai recupere ces codes mais plus maintenant, alors .....
      0
  13. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      Pas possible de remettre outlook sur les PC ou il a disparu?????
      0
  14. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,

      Non, tous les parametres sont renseignes et le serveur ne veut pas repondre.........
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
         
        Re,
        Si j'utilise le serveur smtp free, ca marche donc, vient bien de smtp gmail
        0
  15. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      Oui, mais pareil déjà vu et pas marche, par contre vous pouvez essayer.....
      0
  16. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour,

      Si, il y a un message mais as que...!!
      Quelle erreur avez-vous ?
      0
  17. jean300 Messages postés 382 Statut Membre 14
     
    Bonjour mon ami,
    .Send se surligne en jaune
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
  18. jean300 Messages postés 382 Statut Membre 14
     
    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
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      Desole, en effet pas d'erreur, mais pas marche aucun @mail recu!!!
      0
  19. jean300
     
    Re,
    Je viens de voir ceci, je ne sais si ça pourra t'aider ?
    http://www.cjoint.com/c/GJgnMR8e8MO
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      Non, c'est toujours les meme codes et donc pas marche
      Merci quand meme
      0
  • 1
  • 2
  • 3
  • 4