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