Problème Macro Excel - vérification liste de mails via mailtester.com

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Je souhaiterais réaliser une macro qui me permettrait de tester la validité d'une liste d'adresses mail sur le site http://www.mailtester.com/testmail.php.

Le site permet de tester une adresse à la fois et un ami m'a dit qu'il était possible de tester la liste grâce à une macro.

Je n'ai aucune connaissance en VBA et donc il a ébauché pour moi une première macro en utilisant Internet Explorer. Le problème actuel est que ma macro vérifie bien la première adresse mais elle ne passe pas aux suivantes automatiquement.

Voici la macro actuelle :

Code:

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
Sub Test_mails()
 
'Définition des variables
Dim IEapp As New InternetExplorer
Dim maPageHtml As HTMLDocument
Dim Helem As IHTMLElementCollection
Dim LeTexteExtrait As String
 
'Ouverture de mail tester avec Internet Explorer
IEapp.navigate ("http://mailtester.com/testmail.php")
IEapp.Visible = True
Do While Not IEapp.readyState = 4
Loop
 
'Recherche du champs à remplir sur la page internet
Set maPageHtml = IEapp.document
Set Helem = maPageHtml.getElementsByTagName("input")
 
'Une fois le champs trouvé, on le rempli avec l'adresse mail à tester
With Helem
.Item(1).innerText = Worksheets("Adresses mail").Cells(1, 1).Value
End With
 
'On clique sur le bouton "check address"
Helem(2).Click
 
'C'est là que ça ne fonctionne plus. Je veux copier le contenu de la page en faisant ctrl+A puis ctrl+C (utilisation de la commande SendKeys). Une autre piste et d'identifier le tableau (.getelementbytype ou un truc du genre) qui contient le résultat du test et d'en extraire les données.
With maPageHtml
Application.Wait Now + TimeValue("00:00:1")
Application.SendKeys "^a"
Application.Wait Now + TimeValue("00:00:1")
Application.SendKeys "^c"
End With
 
'On colle le contenu en format texte sur une page du classeur excel
Workbooks("Essai requête mail tester.xlsm").Worksheets("Feuille de travail").Activate
Range("a1").Select
ActiveSheet.PasteSpecial Format:="Texte"
 
'On ferme internet explorer puis on vide les variables (je pense qu'on ne fermera plus la fenêtre internet quand on voudra automatiser la macro sur 10 000 adresses mail)
IEapp.Quit
Set IEapp = Nothing
Set maPageHtml = Nothing
Set Helem = Nothing
 
End Sub

Merci d'avance pour votre aide

04/02/2019, 16h59
juvaxe

Problème de réponse ?

Bonjour

Je cherche également à vérifier l'existence d'une adresse Mail par le biais d'une macro Excel.

Je cherche une solution native en VBA Excel pour éviter une fuite éventuelle des adresses testées sur un site externe.

N'ayant pas trouvé de solution je suis en train d'essayer celle qui est proposé dans le classeur "Essai requête mail tester".

J'ai un souci car au retour du site "mailtester" la Feuille de travail qui devrait contenir le résultat de la requête ne contient en fait que le libellé de l'adresse mail qui a été soumise au contrôle du site.

Si quelqu'un a une réponse ...

Merci d'avance. Bien cordialement

re
bonsoir
la page web a une bonne protection on ne peut en récupérer les résultat dans la table par robot (vba ou autre)
conclusion par vba c'est NON!!!
j'ai testé je precise

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test()
mai_valid "toto1@msn.com"
End Sub
Function mai_valid(adresse As String)
Dim ie As Object
With CreateObject("internetexplorer.application")
.Visible = True
.navigate "http://mailtester.com/testmail.php"
Do: DoEvents: Loop While .readystate <> 4
.document.getelementsbyname("email")(0).Value = adresse
.document.getelementsbytagname("input")(2).Click
Do: i = i + 1: DoEvents: Loop While .readystate <> 4 Or .busy Or i = 100000
Debug.Print .document.body.innerhtml
.Quit
End With
End Function

04/02/2019, 21h05
juvaxe

Essai avec debug.print

Merci pour ta réponse rapide

Je ne vois pas comment exploiter l'option avec debug.print.

Je pense abandonner ma recherche et revenir à une solution manuelle et au cas par cas en cas de besoin de vérifier l'existence d'une adresse mail.

Merci à nouveau

Bien cordialement
04/02/2019, 21h13
patricktoulon

re

re
le debug.print c'est pour incrire dans l'equivalant de la console pour un doc html

ouvre editeur vba ,menu affichage ,fenetre d'execution

re
je viens meme d'en essayer un autre et meme topo protégé a fond

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub test()
MsgBox mai_valid("toto1@msn.com")
End Sub
Function mai_valid(adresse As String)
Dim ie As Object
With CreateObject("internetexplorer.application")
.Visible = True
.navigate "https://captainverify.com/fr/mail-tester.html"
Do: DoEvents: Loop While .readystate <> 4
.document.getelementsbyname("mailtester")(0).Value = adresse
.document.getelementsbytagname("input")(1).Click
Do: i = i + 1: DoEvents: Loop While .readystate <> 4 Or .busy Or i = 100000
For Each elem In .document.all
If elem.classname = "unit whole label-invalide" Then mai_valid = "invalid": Exit Function
Next
'.Quit
End With
End Function

Bonjour

Par la requête POST, on peux récupérer quelque chose

Code:

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
Sub Test()
 
MAILTEST "monamail@xxxx.yyy"
End Sub
 
Private Sub MAILTEST(ByVal Email As String)
Dim Url As String, Reponse As String, Tmp As String
Dim XML As Object, Tbl As Object, Elm As Object
 
Url = "http://mailtester.com/testmail.php"
Set XML = CreateObject("MSXML2.XMLHTTP")
With XML
    .Open "POST", Url, False
 
    .SetRequestHeader "Host", "mailtester.com"
    .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; …) Gecko/20100101 Firefox/56.0"
    .SetRequestHeader "Accept", "text/html,application/xhtml+xm…plication/xml;q=0.9,*/*;q=0.8"
    .SetRequestHeader "Accept-Language", "fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3"
    .SetRequestHeader "Accept-Encoding", "gzip,deflate"
    .SetRequestHeader "Referer", "http://mailtester.com/testmail.php"
    .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .SetRequestHeader "Content-Length", "33"
    .SetRequestHeader "DNT", "1"
    .SetRequestHeader "Connection", "keep-alive"
    .SetRequestHeader "Upgrade-Insecure-Requests", "1"
 
    .Send "lang=en&email=" & Email
    Reponse = .ResponseText
End With
Set XML = Nothing
If Reponse <> "" Then
    With CreateObject("htmlfile")
        .body.innerhtml = Reponse
        Set Tbl = .GetElementsByTagName("table")    '.GetElementsByTagName("option")
 
        For Each Elm In Tbl(1).GetElementsByTagName("tr")
            If Elm.innertext <> "" Then Tmp = Tmp & vbNewLine & Elm.innertext
        Next Elm
    End With
    MsgBox Tmp
End If
End Sub

05/02/2019, 13h23
patricktoulon

re

Bonjour mercatog
bien vu la requete
il faudra decanter les reponses en fonction du domain/serveur invalid car on peut avoir la precision sur le "@xxxx.yyyy"
on a 5 sortes de reponse en fonction de l'email injecté
05/02/2019, 16h51
juvaxe

1 pièce(s) jointe(s)

Solution par "post"

Bonjour

mercatog => merci pour cette excellente solution

patricktoulon => je joins un exemple de ce qui peut être fait pour contrôler plusieurs adresses en une seule fois . Pour distinguer les cinq cas que tu évoques, il faut modifier le code pour préciser ce que l'on souhaite.

On reste à la merci d'un site externe qui peut, au passage, enrichir sa base de données prospect ... vous me direz que c'est le propre d'Internet.

Bien cordialement