email-extractor.vbs

On Error resume next
Dim fCsv 
Dim tb 
Const ForReading = 1
Set fso = CreateObject("scripting.filesystemobject")
Set fCsv = fso.OpenTextFile("urls-list.csv", ForReading) 'config here
If Not fCsv.AtEndOfStream Then fCsv.ReadLine 
 While Not fCsv.AtEndOfStream
 tb = Split(fCsv.ReadLine, ",")
 If UBound(tb) = 2 Then
 Wscript.echo "URL : " & tb(0)
URL = tb(0)
Set WshShell = WScript.CreateObject("WScript.Shell")
Set http = CreateObject("Microsoft.XmlHttp")
On Error Resume Next
http.open "GET", URL, False
http.send ""
if err.Number = 0 Then
 Dim src, ptrn, re, Match, Matches, NewLine, s
src = http.responseText
' Set the pattern to search for an e-mail address.
 ' (More sophisticated RegExp patterns are available for
 ' matching an email address).
 ptrn = "(\w+)@(\w+)\.(\w+)"
' Create the regular expression.
 Set re = New RegExp
 re.Pattern = ptrn
 re.Global = True
' Get the Matches collection
 Set Matches = re.Execute(src)
' Create the output string.
 NewLine = VbCrLf
 s = ""
For Each Match in Matches
 s = s & NewLine
' The Match object contains the entire match.
 s = s & Match.Value
' Get the submatched parts of the address.
 
 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
 
 End If
 Wend

'Dim oPlayer
'Set oPlayer = CreateObject("WMPlayer.OCX")
'oPlayer.URL = "notify.wav"
'oPlayer.controls.play 
'While oPlayer.playState <> 1 ' 1 = Stopped
' WScript.Sleep 100
'Wend
'oPlayer.close