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

Réponse 1 / 77

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

a voir:

https://www.rondebruin.nl/win/s1/outlook/mail.htm

Réponse 2 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Bonjour f894009,
N'aurais-tu le lien en français stp ?
En te remerciant.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Réponse 3 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Je te remercie f894009
Bonne journée à toi
Je reviendrais si problème si tu me le permet

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Ok, pas de probleme

Réponse 4 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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

Réponse 5 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Re
Je viens d'y aller.
Merci pour ce rappel, sympa de ta part.

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > lucien

Bonjour,
Jean300
Petit probleme, avec votre fichier, pas possible clic droit sur les boutons feuilles!!!!!!!!!!!!

lucien > f894009 Messages postés 17277 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é).

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > lucien

Re,
Ok

suite:

envoi par outlook ou cdo ?????

Réponse 6 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

mais la secrétaire
Elle a quoi, cette personne???
Elle a un Office au moins ????

Réponse 7 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Re,
Elle a sur son ordi Office 2003
et sur un autre Office 2013

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
Ben, y a forcément Outlook, comprends pas pourquoi CDO

Réponse 8 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Re,
Sur l'ordi office 2003 il n'y a pas Outloock.
En faite elle a Word, Excel et Powerpoint.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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+

Réponse 9 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
En effet, j'ai teste et pas marche, je regarde car j'ai d'autres fichiers cdo

Réponse 10 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Pas de souci mon ami, j'ai tout mon temps.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Il y aurait un petit probleme avec le serveur smtp Gmail, pas moyen de se connecter avec CDO!!!!!!!

Réponse 11 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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 '" " & body & " " '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 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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!!!!!!

Réponse 12 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Bonjour f894009,
Est-ce que ceci peut t'aider ?

http://www.smtp-gmail.com/

https://www.serversmtp.com/fr/configuration-smtp-gmail/

https://clients.desmondes.com/knowledgebase/392/SMTP-Gmail.html

En te souhaitant une bonne journée.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Merci, mais deja vu et ca marchait au moment ou j'ai recupere ces codes mais plus maintenant, alors .....

Réponse 13 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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é.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Pas possible de remettre outlook sur les PC ou il a disparu?????

Réponse 14 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,

Non, tous les parametres sont renseignes et le serveur ne veut pas repondre.........

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

Re,
Si j'utilise le serveur smtp free, ca marche donc, vient bien de smtp gmail

Réponse 15 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Re,
As-tu vu ceci ?

https://www.developpez.net/forums/d1469590/logiciels/microsoft-office/excel/macros-vba-excel/composant-activex-ne-creer-objet/#post7968025

Ne comprenant pas l'anglais, pas facile pour moi.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
Deja essaye, pas mieux................!

Réponse 16 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
Oui, mais pareil déjà vu et pas marche, par contre vous pouvez essayer.....

Réponse 17 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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.

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour,

Si, il y a un message mais as que...!!
Quelle erreur avez-vous ?

Réponse 18 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 14

Bonjour mon ami,
.Send se surligne en jaune

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Réponse 19 / 77

jean300 Messages postés 374 Date d'inscription Statut Membre Dernière intervention 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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
Desole, en effet pas d'erreur, mais pas marche aucun @mail recu!!!

Réponse 20 / 77

jean300

Re,
Je viens de voir ceci, je ne sais si ça pourra t'aider ?
http://www.cjoint.com/c/GJgnMR8e8MO

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
Non, c'est toujours les meme codes et donc pas marche
Merci quand meme

Envoi mail à partir feuille Excel 2003

77 réponses

Votre réponse

Discussions similaires