'------------------------------------------------------------------------
'               Copyright (C) 2002 Marios Polyzoes. marpoly@ geo.gr
'------------------------------------------------------------------------
'SN: 020329

L_Welcome_MsgBox_Message_Text   = "This searches for email addresses in a file" & Chr(13) & "and creates a file named 001.txt with the addresses in it"
L_Welcome_MsgBox_Title_Text     = "Utility by Marios Polyzoes"
Call Welcome()

' ********************************************************************************

Dim WSHShell,sfile, dfile, fso, f, ts, sLine, sMail, redf, regEx, thisFolder, AllFiles
Set WSHShell = WScript.CreateObject("WScript.Shell")
sLine = "x"
n = 0
'------------------------------------------------


const pth = "./"
  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
sfile = "atest.txt" ' Give the name of the file you want to search
dfile = "c:\001.txt"
'-----------------------------------------------

Function RegExpMail(sLine)
   Set regEx = New RegExp   ' Create a regular expression.
   regEx.Pattern = "(\S+)@(\S+)\.(\w+)"   ' Set pattern.
   regEx.IgnoreCase = True   ' Set case insensitivity.
   regEx.Global = True   ' Set global applicability.
   Set Matches = regEx.Execute(sLine)   ' Execute search.
   For Each Match in Matches   ' Iterate Matches collection.
      RetStr = RetStr & Match.Value 
   Next
   RegExpMail = RetStr
End Function
' MsgBox(RegExpMail("is.", "IS1 is2 IS3 is4"))


  Set fso = CreateObject("Scripting.FileSystemObject")
  fso.CreateTextFile (dfile)
  Set f = fso.GetFile(dfile)
  Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

'-----------------

Set fso = CreateObject("Scripting.FileSystemObject")
Set redf = fso.OpenTextFile(sfile, ForReading)
'-----------------------------------


Do While redf.AtEndOfStream <> True
sLine = redf.ReadLine
sMail = (RegExpMail(sLine))
 If sMail <> "" Then 

ts.WriteLine (sMail)

 End if


'DefResp = MsgBox ("Το " & sLine & ".com  domain?", vbYesNo)

Loop
  ts.Close

WScript.Echo "The work is done. Thanks!"


' ********************************************************************************
' *
' * Welcome
' *
Sub Welcome()
    Dim intDoIt

    intDoIt =  MsgBox(L_Welcome_MsgBox_Message_Text, _
                      vbOKCancel + vbInformation,    _
                      L_Welcome_MsgBox_Title_Text )
    If intDoIt = vbCancel Then
        WScript.Quit
    End If
End Sub