Change outlook account with MAPI

Function ValidateEmail(inEmail)
	Dim email
	email = inEmail
	
	Dim re
	Set re = New RegExp
	re.Pattern = "^[\w\-\.]*[\w\.]\@[\w\.]*[\w\-\.]+[\w\-]+[\w]\.+[\w]+[\w $]"
	
	If re.Test(email) = False Then
		ValidateEmail = False
	Else
		ValidateEmail = True
	End If
End Function




Dim ToAddress
Dim MessageSubject
Dim MessageBody
Dim ol, ns, newMail
Dim conn, rs, count
count = 0

ToAddress = ""
MessageSubject = "SA BookNews Online Weekly Newsletter - Friday 18 August 2006"

'----READ BODY FROM TEXT FILE
Set fs=CreateObject("Scripting.FileSystemObject")
Set f=fs.OpenTextFile("c:\newsletter.txt", 1)

MessageBody = f.ReadAll

f.Close

Set f=Nothing
Set fs=Nothing
'----END OF READ BODY FROM TEXT FILE


'----READ EMAILS FROM DB
set conn = CreateObject("ADODB.Connection")
set rs = CreateObject("ADODB.Recordset")

conn.Open "*******"
rs.Open "select DISTINCT ltrim(rtrim(nls_email)) as EMail from bkn_NewsLetterSubscriberMail " & _
			"where nls_RequestedThisLetter IS NULL or nls_RequestedThisLetter = 1", conn

while not rs.EOF

if ValidateEmail(rs("Email")) then
	ToAddress = ToAddress & rs("EMail") & ";"
	count = count + 1
end if
	
	rs.MoveNext

if count = 25 or rs.EOF then

	'----SEND EMAIL
	Set ol = WScript.CreateObject("Outlook.Application")
	Set ns = ol.getNamespace("MAPI")
	
	Set newMail = ol.CreateItem(olMailItem)
	newMail.Subject = MessageSubject
	newMail.HTMLBody = MessageBody
		
	   newMail.BCC = ToAddress
	   newMail.Save	

	Set ol = Nothing
	'----END OF SEND EMAIL
	
	count = 0
	ToAddress = ""
end if

wend 

conn.close
rs.close
set conn = nothing
set rs = nothing

msgbox "Email Export Complete!"