emails-exctractor.vbs

On Error resume next
lefichier= InputBox("URL :")
If (lefichier <> "") Then
WScript.Sleep 200
else
Wscript.Quit
end if
URL = lefichier
Set WshShell = WScript.CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
http.open "GET", URL, False
http.send ""
if err.Number = 0 Then
Dim src, ptrn, re, Match, Matches, NewLine, s
src = http.responseText
ptrn = "(\w+)@(\w+)\.(\w+)"
Set re = New RegExp
re.Pattern = ptrn
re.Global = True
Set Matches = re.Execute(src)
NewLine = VbCrLf
s = ""
For Each Match in Matches
s = s & NewLine
 s = s & Match.Value
Next
WScript.Echo (s) 
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
FichierTXT = "new-emails.txt"
Set NewFichier = fso.CreateTextFile(FichierTXT,TRUE)
NewFichier.WriteLine(s)
Set fso = Nothing
Else
Wscript.Echo "error " & Err.Number & ": " & Err.Description
End If
set WshShell = Nothing
Set http = Nothing
Wscript.Quit