vbs invia messaggii email utenti - vbs

'

' vbs - invia circoloare email

' indirizzi contenuti in un file di testo

option explicit

'

dim dbelencoutenti, toggetto, tcorpo, contenutoletto, dbarchiviomsg, dboggetto

'

Dim EmailValidator : Set EmailValidator = GetEmailValidator() ' per verificare indirizzo email

'

dbelencoutenti="C:\articoli-nuovi\db-email-utenti-da-avvisare.txt"

dbarchiviomsg="C:\articoli-nuovi\db-messaggio-corpo.txt"

dboggetto="C:\articoli-nuovi\db-messaggio-oggetto.txt"



' corpo del messaggio

call leggitutto(dbarchiviomsg)

tcorpo = contenutoletto

' oggetto messaggio

call leggitutto(dboggetto)

toggetto = contenutoletto

' legge elenco indirizzi email

call leggielenco(dbelencoutenti)

' ====

sub leggielenco(filedaleggere)

dim objFSO, objFile, strLine

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFile = objFSO.OpenTextFile(filedaleggere, 1)

'

Do While objFile.AtEndOfStream = False

strLine = objFile.ReadLine

if EmailValidator.Test(strline) = true then

call invaemail(strLine)

'msgbox strline

end if

Loop

'

objFile.Close

Set objFSO = Nothing

Set objFile = Nothing

'

end sub

' ====

'

sub invaemail(indirizzoemail)

dim objEmail

Set objEmail = CreateObject("CDO.Message")

objEmail.From = "articoli-nuovi@#vostro-dominio#.#suffisso#"

objEmail.To = indirizzoemail

objEmail.Subject = toggetto

objEmail.Textbody = tcorpo

objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' 1

objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = " #vostro#server#di#posta#"

objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objEmail.Configuration.Fields.Update

objEmail.Send

'

end sub

'

'

Function GetEmailValidator()

Set GetEmailValidator = CreateObject("VBScript.RegExp") 'New RegExp

GetEmailValidator.Pattern = "^((?:[A-Z0-9_%+-]+\.?)+)@((?:[A-Z0-9-]+\.)+[A-Z]{2,4})$"

GetEmailValidator.IgnoreCase = True

End Function

'

' =========

sub leggitutto(pfiledaleggere)

'

dim objFSO, objFile

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(pfiledaleggere) Then

'esistefile = "si"

Set objFile = objFSO.OpenTextFile(pfiledaleggere, 1)

contenutoletto = objFile.Readall

objFile.Close

Else

'esistefile = "no"

contenutoletto = ""

End If

Set objFSO = Nothing

'

end sub

' ====



'