Envoi mail automatique

**pouldom** · 09/10/2017, 09h08

Bonjour à tous,

Je reviens vers vous pour que vous m'aidiez si possible à résoudre un problème.

J'ai un tableau excel avec des dates d'anniversaires, celui ci à chaque date anniversaire envoie un mail automatique de rappel.
Depuis le mois de juillet j'ai changé d'opérateur . Anciennement SFR maintenant Orange, depuis cette date les mails de rappel ne sont plus envoyés.
Il y a dans VBA une procédure dans laquelle j'ai modifié l'adresse mail d'expéditeur sans aucun résultat.

Si vous pouviez m'orienter et m'expliquer ce qui bug.

Merci, cordialement

**Jean-Philippe André** · 09/10/2017, 12h51

Bonjour,

le probleme vient de ton code.

Mais comme tu ne nous l'as pas encore montre, je dirais que la reponse est 42.

Merci de faire un effort pour nous donner plus d'informations.

Invité · 09/10/2017, 12h54

bonjour,

http://mobcom.fr/v4/parametrage-messageries-mobcom

**patricktoulon** · 09/10/2017, 12h57

bonjour

quelle méthode est utilisée pour l'envoie(Outlook,CDO,USE,etc...)
ton code il est oû

**pouldom** · 09/10/2017, 22h38

Bonsoir,

Désolé j'ai oublié de mettre le code VBA.

le voici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Private Sub Workbook_Open()
 
'!!! Il faut référencer "Microsoft CDO for Windows 2000 Library" via Tools\References
 
Dim R As Long, DerLig As Long 'Dimensionnement des variables
Dim Cdo_Message As Object
Set Cdo_Message = CreateObject("CDO.Message")
Set Cdo_Message.Configuration = GetSMTPServerConfig() 'Lance la procédure de configuration
DerLig = Sheets("BDD").Cells(Columns(3).Cells.Count, 3).End(xlUp).Row 'récupère le numéro de la dernière ligne remplie sur base de la colonne C
 
For R = 3 To DerLig 'Boucle sur chaque ligne depuis la 3ème jusqu'à la dernière (via la variable BerLig)
  If Sheets("BDD").Cells(R, 3) = Date And Sheets("BDD").Cells(R, 6) <> "Envoyé" Then
 
'Envoi le mail via CDO !!! invisible pour l'utilisateur
           With Cdo_Message
               .To = Sheets("BDD").Cells(R, 5).Value 'Récupère l'adresse du destinataire
'!!!! Adapter la ligne .from avec ton adresse e-mail
               .From = "poulain.dominique80@orange.fr" 'ADAPTER avec ton adresse e-mail"
               .Subject = "Mail automatique: Rappel"
               .HTMLBody = Sheets("BDD").Cells(R, 4) + Cells(R, 1) 'Récupère le message à insérer
               .send
           End With
       Sheets("BDD").Cells(R, 6) = "Envoyé"
  End If
Next R 'Passe à la ligne suivante
Set Cdo_Message = Nothing
End Sub
 
Function GetSMTPServerConfig() As Object
' Microsoft CDO for Windows 2000 Library
   Const cdoSendUsingPickup = 1
   Const cdoSendUsingPort = 2
   Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
   Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
   Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
 
   Dim Cdo_Config As Object
   Set Cdo_Config = CreateObject("CDO.Configuration")
   Dim Cdo_Fields As Object
   Set Cdo_Fields = Cdo_Config.Fields
 
   With Cdo_Fields
       .Item(cdoSendUsingMethod) = cdoSendUsingPort
'!!!! Adapter l'adresse SMTP, je connais pas Thunderbird, donc difficile de t'indiquer comment la récupérer
       .Item(cdoSMTPServer) = "smtp.orange.fr"
       .Item(cdoSMTPServerPort) = 25
       .Update
   End With
 
   Set GetSMTPServerConfig = Cdo_Config
   Set Cdo_Config = Nothing
   Set Cdo_Fields = Nothing
 
End Function

et le tableau excel
Nom Date naissance Date anniversaire Message Adresse email

Merci de vous intéresser à mon problème.

Cordialement

Invité · 10/10/2017, 07h34

Bonjour,

!!! Il faut référencer "Microsoft CDO for Windows 2000 Library" via Tools\References

Vue que tu utilises CreateObject c'est inutile!

Depuis 2016 orange est passé en Ipv6 , je doute de plus en plus de l'utilisation du port 25 sens authentification!

Le part feu et certain logiciels n'aime pas Ipv6! Je penses qu'il est possible de le désactiver dans les options orange???

Une application qui fonctionnait hier devrait fonctionner au jour hui!

En plus comme nous lisons attentivement les messages avant de dire Ok, il est fort à parier que ton antivirus est mis orange en quarantaine!

**pouldom** · 10/10/2017, 08h52

Bonjour,

Merci pour votre réponse , je vais contrôler le paramétrage de mon antivirus .
Cordialement

Invité · 10/10/2017, 09h06

intéresse toi également à ça: https://assistance.orange.fr/livebox..._161850-528413

**pouldom** · 10/10/2017, 10h43

Bonjour,

Je n'ai rien trouvé sur le paramétrage .
c'est en IPV4.

J'ai essayé de désactiver le pare feu de Windows et le résultat est idem.

Merci

**patricktoulon** · 10/10/2017, 19h24

re
Bonjour
a l'ancienne essaie cela en changeant l'emetteur et le destinataire et envoie toi le a toi meme et regarde si cela arrive dans ta boite mail
regarde aussi dans tes indésirables si tu met un emetteur un trop loufoque

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub send_email_with_range()
 
    Dim message As Object, iConf As Object
    Dim BodyHtml As String
    Dim i As Byte, j As Byte
    Set message = CreateObject("CDO.Message")
 
    With message.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
        '.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic 'on s'en sert pas 
        '.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser  'on s'en sert pas
        '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPassword  'on s'en sert pas
        .Update
    End With
    BodyHtml = ""
    BodyHtml = BodyHtml & "<HEAD>"
    BodyHtml = BodyHtml & "<BODY>"
    BodyHtml = BodyHtml & "Bonjour , <BR>vous trouverez ci joint le tableau demandé<BR><BR>"
    BodyHtml = BodyHtml & "<B><SPAN STYLE='background-color:green;font-size:6mm'>Résultats : </SPAN></B><BR><BR>"
    'BodyHtml = BodyHtml & Basic_convert_range_TableHTML(Range("A1:B5"))' fonction perso 
    BodyHtml = BodyHtml & "<BR><BR>Cordialement<BR>" & Environ("username")
    BodyHtml = BodyHtml & "</BODY>"
    BodyHtml = BodyHtml & ""
    With message
 
        .To = "moimeme@hotmail.fr"    'renvoie une erreur si l'adresse est non valide
        .From = "quelqun@hotmail.fr"
        .Subject = "Test Envoi Tableau par mail"
        .HTMLBody = BodyHtml
        .send
    End With
End Sub

**pouldom** · 15/10/2017, 10h49

Bonjour

Merci pour votre réponse, je vais essayer le code que vous m'avez envoyé.
Je vous tiens au courant du résultat.

Cordialement

**pouldom** · 15/10/2017, 11h00

Rebonjour,

J'ai essayé le code et ça ne fonctionne pas non plus.

Merci tout de même pour votre investissement.
Cordialement.

**patricktoulon** · 15/10/2017, 12h23

re
il ne fonctionne pas OK mais c'est quoi les message d'erreur ou ca bloque ???? si tu nous dis rien on pourra jamais deviner

Invité · 15/10/2017, 12h55

Bonjour,
De nos jours les hébergeur autorise de moins en moins le contournement de l'ipV6.

Comme dit plus haut, orange l'a implémenté en 2016. Il autorise un déverrouillage sur la box uniquement, bref le port 25 sens authentification uniquement à la maison!

Free l'autorise sur sont site via le compte utilisateur!

En fait dans un avenir plus ou moins proche la seule solution serra celle ci ou même principe: https://blog.netapsys.fr/utilisation...sagerie-local/

**pouldom** · 15/10/2017, 14h18

Il n'y a pas de message d'erreur, l'email n'est pas envoyé au destinataire.

Envoi mail automatique

Macros et VBA Excel

Discussions similaires

Partager

Partager