Request for help with VBScript...

[D.R.]

Hi Forum,

I have tried to write a VBScript (to be called using "cscript
z:\folder\script.vbs") as a tool/utility to time email delivery. Basically
it sends two emails, one to an email gateways providers echo service, and
another to itself. The scripts purpose is to record delivery delay timings,
as part of an excercise to determine and record quality of performance and
service. Its pretty simple at the moment, and I would like to make it more
detailed, and I would like to get it to run as a scheduled task either on a
workstation or on a server.

I have several problems with the following script. I think it's because I'm
using older (Outlook 2002) constructs that now cause popups in Outlook 2003.

My problems are:
1) Script will only run on Win 2000 Pro SP4 with Outlook 2000 whilst the
user session is logged on.
2) Will not run quietly in Windows XP SP2 with Outlook 2003, as it generates
5 second wait popups.
3) Will not run on Win 2000 Pro SP4 with Outlook 2000 as a scheduled task
for a non-logged on user.
4) I've tried using .Logon "user", "password" but this doesn't work as a
scheduled task in non-logged on user.

Also, I would like to be able to access the mail headers and read/parse the
details of message gateways that the email is passed via/through, and then
to pull out the timings of each hop. Any ideas how to access the email
header/internals?

Thanks,
Dave.

P.S. Here's my script so far...




Option Explicit
'*******************************************************************************************************************************************************
'* File: "simple-email-timing-recorder.vbs"
'* Purpose: Send an echo and a local email, and record the number seconds
between sending and receiving a reply.
'*
'* Vers Date Who Description
'* ---- ---- --- -----------
'* v0.01 21-MAR-2007 DR First draft to list presence of echo replies.
'* v0.02 22-MAR-2007 DR Send an email to echo address.
'* v0.03 22-MAR-2007 DR First attempt at waiting for a reply, and writing
summary csv file.
'* v0.04 22-MAR-2007 DR Added local message timing, and mark messages as
read before deleting.
'* v0.05 22-MAR-2007 DR Append to a log file.
'* v0.06 22-MAR-2007 DR Connect to Outlook.Application once, open log at
start.
'* v0.07 26-MAR-2007 DR Logon, and use username and pass saved in a text
"info" file.
'* v0.08 27-MAR-2007 DR Logon at start of script, logoff at end of script.
'* v0.09 28-MAR-2007 DR No longer use .logon.
'*******************************************************************************************************************************************************
Const cs_script_version = "v0.09"
'*******************************************************************************************************************************************************
'* Usage:
'*******************************************************************************************************************************************************
'* Changes to make:
'* - zzzz
'*******************************************************************************************************************************************************

Const olFolderInbox = 6
Const olMailItem = 0

Const ci_for_reading = 1
Const ci_for_writing = 2
Const ci_for_appending = 8

Dim go_fso, go_outlook, go_namespace
Dim gs_script_spec, gs_script_path, gs_script_name, gs_script_title,
gs_script_fac
Dim gs_log_spec, go_log_chan
Dim gd_run_date_dt, gs_run_date_yyyymmdd, gs_run_date_day, gs_run_date_time
Dim gd_echo_sent, gd_echo_received, gl_echo_diff, gb_echo_timeout
Dim gd_local_sent, gd_local_received, gl_local_diff, gb_local_timeout

Call s_init()
Call s_echo_timing()
Call s_local_timing()
Call s_write_csv()

Call s_log( gs_script_fac & "Script exiting..." )
WScript.Quit(0)




Sub s_init()
Const cs_fac = "%s_init, "

Set go_fso = CreateObject( "Scripting.FileSystemObject" )

gs_script_spec = WScript.ScriptFullName
gs_script_path = go_fso.GetParentFolderName( gs_script_spec )
gs_script_name = go_fso.GetBaseName( gs_script_spec )
gs_script_title = gs_script_name & " (" & cs_script_version & ")"
gs_script_fac = "%" & gs_script_name & ", "

gs_log_spec = gs_script_path & "\" & gs_script_name & ".log"
Set go_log_chan = go_fspenTextFile( gs_log_spec, ci_for_appending,
True )
go_log_chan.WriteLine String( 150, "*" )
Call s_log( gs_script_fac & "Script started (" & cs_script_version &
")..." )

gd_run_date_dt = Now()
gs_run_date_yyyymmdd = Year( gd_run_date_dt ) & "-" & fs_zeroes( Month(
gd_run_date_dt ), 2 ) & "-" & fs_zeroes( Day( gd_run_date_dt ), 2 )
gs_run_date_day = WeekDayName( WeekDay( gd_run_date_dt ), True )
gs_run_date_time = FormatDateTime( gd_run_date_dt, vbLongtime )

On Error Resume Next
Set go_outlook = CreateObject( "Outlook.Application" )
If Err.Number <> 0 Then Call s_error( cs_fac & "Failed to connect to
`Outlook.Application`..." )
On Error Goto 0

On Error Resume Next
Set go_namespace = go_outlook.GetNameSpace( "MAPI" )
If Err.Number <> 0 Then Call s_error( cs_fac & "Failed to get MAPI name
space..." )
On Error Goto 0

Call s_log( gs_script_fac & "Outlook username `" &
go_namespace.CurrentUser & "`..." )
End Sub




Sub s_echo_timing()
Const cs_fac = "%s_echo_timing, "
Const cs_echo_subject = "Clearswift Echo Service"
Const cl_echo_wait_seconds = 10
Const cl_echo_waits_max = 10

Dim lo_mail, ls_recipient, ls_subject, ls_body, lo_inbox, lc_messages,
lo_message
Dim lb_echo_received, ll_echo_waits_cnt

ls_recipient = "(e-mail address removed)"
ls_subject = "Test"
ls_body = "Test"


'Delete any old previously exisiting replies...
Set lo_inbox = go_namespace.GetDefaultFolder( olFolderInbox )
Set lc_messages = lo_inbox.Items
For Each lo_message In lc_messages
If LCase( lo_message.Subject ) = LCase( cs_echo_subject ) Then
lo_message.Unread = False
lo_message.Delete
Call s_log( cs_fac & "Deleted an old reply..." )
End If
Next


'Send an email to the echo address...
Set lo_mail = go_outlook.CreateItem( olMailItem )

lo_mail.Recipients.Add ls_recipient
lo_mail.Subject = ls_subject
lo_mail.Body = ls_body

lo_mail.Send
gd_echo_sent = Now()

Call s_log( cs_fac & "Echo email sent to `" & ls_recipient & "`..." )


' Now wait for a reply...
gb_echo_timeout = False
lb_echo_received = False
ll_echo_waits_cnt = 0

Do
ll_echo_waits_cnt = ll_echo_waits_cnt + 1

Call s_log( cs_fac & "Wait `" & ll_echo_waits_cnt & "`..." )

WScript.Sleep cl_echo_wait_seconds * 1000


Set lo_inbox = go_namespace.GetDefaultFolder( olFolderInbox )

Set lc_messages = lo_inbox.Items

For Each lo_message In lc_messages
If LCase( lo_message.Subject ) = LCase( cs_echo_subject ) Then
gd_echo_received = CDate( lo_message.ReceivedTime )
Call s_log( cs_fac & "Echo reply received at `" & gd_echo_received &
"`..." )

gl_echo_diff = DateDiff( "s", gd_echo_sent, gd_echo_received )
Call s_log( cs_fac & "Interval of `" & gl_echo_diff & "`
seconds..." )

lo_message.Unread = False
lo_message.Delete
Call s_log( cs_fac & "Message deleted..." )

lb_echo_received = True
End If
Next

If ll_echo_waits_cnt >= cl_echo_waits_max Then
gb_echo_timeout = True
Call s_log( cs_fac & "Timeout waiting for echo reply..." )
End If

Loop Until lb_echo_received Or gb_echo_timeout

End Sub




Sub s_local_timing()
Const cs_fac = "%s_local_timing, "
Const cs_local_subject = "Local timing test..."
Const cl_local_wait_seconds = 10
Const cl_local_waits_max = 10

Dim lo_mail, ls_recipient, ls_subject, ls_body, lo_inbox, lc_messages,
lo_message
Dim lb_local_received, ll_local_waits_cnt


ls_recipient = go_namespace.CurrentUser
ls_subject = cs_local_subject
ls_body = "Test"


'Delete any old previously exisiting replies...
Set lo_inbox = go_namespace.GetDefaultFolder( olFolderInbox )
Set lc_messages = lo_inbox.Items
For Each lo_message In lc_messages
If LCase( lo_message.Subject ) = LCase( cs_local_subject ) Then
lo_message.Unread = False
lo_message.Delete
Call s_log( cs_fac & "Deleted an old reply..." )
End If
Next


'Send an email to the local address...
Set lo_mail = go_outlook.CreateItem( olMailItem )

lo_mail.Recipients.Add ls_recipient
lo_mail.Subject = ls_subject
lo_mail.Body = ls_body

lo_mail.Send
gd_local_sent = Now()

Call s_log( cs_fac & "Local email sent to `" & ls_recipient & "`..." )


' Now wait for a reply...
gb_local_timeout = False
lb_local_received = False
ll_local_waits_cnt = 0

Do
ll_local_waits_cnt = ll_local_waits_cnt + 1

Call s_log( cs_fac & "Wait `" & ll_local_waits_cnt & "`..." )

WScript.Sleep cl_local_wait_seconds * 1000


Set lo_inbox = go_namespace.GetDefaultFolder( olFolderInbox )

Set lc_messages = lo_inbox.Items

For Each lo_message In lc_messages
If LCase( lo_message.Subject ) = LCase( cs_local_subject ) Then
gd_local_received = CDate( lo_message.ReceivedTime )
Call s_log( cs_fac & "Local reply received at `" & gd_local_received
& "`..." )

gl_local_diff = DateDiff( "s", gd_local_sent, gd_local_received )
Call s_log( cs_fac & "Interval of `" & gl_local_diff & "`
seconds..." )

lo_message.Unread = False
lo_message.Delete
Call s_log( cs_fac & "Message deleted..." )

lb_local_received = True
End If
Next

If ll_local_waits_cnt >= cl_local_waits_max Then
gb_local_timeout = True
Call s_log( cs_fac & "Timeout waiting for local reply..." )
End If

Loop Until lb_local_received Or gb_local_timeout

End Sub




Sub s_write_csv()
Const cs_fac = "%s_write_csv, "
Dim ls_csv_month, ls_csv_spec, lo_csv_chan, ls_csv_line

ls_csv_month = Year( gd_run_date_dt ) & "-" & fs_zeroes( Month(
gd_run_date_dt ), 2 )
ls_csv_spec = gs_script_path & "\" & gs_script_name & "-" & ls_csv_month &
".csv"

Call s_log( cs_fac & "Writing to `" & ls_csv_spec & "`..." )

If go_fso.FileExists( ls_csv_spec ) Then
On Error Resume Next
Set lo_csv_chan = go_fspenTextFile( ls_csv_spec, ci_for_appending,
True )
Select Case Err.Number
Case 0
Case 70
Call s_error( cs_fac & "File is locked by another user..." )
Case Else
Call s_error( cs_fac & "Unexpected error opening CSV file..." )
End Select
On Error Goto 0
Else
Set lo_csv_chan = go_fspenTextFile( ls_csv_spec, ci_for_writing,
True )
lo_csv_chan.WriteLine "Date,Day,Time,Echo Sent,Echo Rcv,Echo Diff,Local
Sent,Local Rcv,Local Diff"
End if

ls_csv_line = gs_run_date_yyyymmdd & "," & gs_run_date_day & "," &
gs_run_date_time

If gb_echo_timeout Then
ls_csv_line = ls_csv_line & ",'" & fs_dt( gd_echo_sent ) &
",timeout,timeout"
Else
ls_csv_line = ls_csv_line & ",'" & fs_dt( gd_echo_sent ) & ",'" &
fs_dt( gd_echo_received ) & "," & gl_echo_diff
End If

If gb_local_timeout Then
ls_csv_line = ls_csv_line & ",'" & fs_dt( gd_local_sent ) &
",timeout,timeout"
Else
ls_csv_line = ls_csv_line & ",'" & fs_dt( gd_local_sent ) & ",'" &
fs_dt( gd_local_received ) & "," & gl_local_diff
End If

Call s_log( cs_fac & "Writing `" & ls_csv_line & "` to CSV file..." )

lo_csv_chan.WriteLine ls_csv_line

lo_csv_chan.Close
End Sub




Sub s_log( ps_text )
Dim ls_text
ls_text = fs_dt( Now() ) & " " & ps_text
WScript.Echo ls_text
go_log_chan.WriteLine ls_text
End Sub




Sub s_error( ps_message )
Const cs_fac = "%s_error, "
Dim ls_message, ls_error
ls_error = Trim( Replace( Err.Description, vbCrlf, "" ) )
ls_message = cs_fac & "Script has encountered an error, cannot continue,
and will now abort..."
ls_message = ls_message & vbCrlf & " at: " & fs_dt(Now)
ls_message = ls_message & vbCrlf & " reason: " & ps_message
ls_message = ls_message & vbCrlf & " error: " & Err.Number
ls_message = ls_message & vbCrlf & " text: " & ls_error
ls_message = ls_message & vbCrlf & " source: " & Err.Source
Call s_log( ls_message )
WScript.Quit( Err.Number )
End Sub




Function fs_zeroes( pl_number, pl_length )
Const cs_fac = "%fs_zeroes, "
Dim ls_result
ls_result = String( pl_length, "0" ) & CStr( pl_number )
ls_result = Right( ls_result, pl_length )
fs_zeroes = ls_result
End Function




Function fs_dt( pd_dt )
fs_dt = FormatDateTime( pd_dt, vbShortdate ) & " " & FormatDateTime(
pd_dt, vbLongtime )
End Function

 

[neo [mvp outlook]]

Outlook (all versions) wasn't designed to be used under a scheduled task.
Second, you have to contend with the enhanced object security model that
exists under Outlook 2000 SP3 and later by rewriting the application to use
extended mapi. Something that is definitely beyond the ability of the
scripting libraries.

If it where me where a message needs to be send from a scheduled task, I
would use the "CDO for Windows 2000" library to construct and send e-mail.
This way I could continue using vbscript, make it a scheduled task, and not
have to worry about the enhanced security within Outlook or even making sure
that Outlook is installed on server "X" where it just might not be
supported.

Now, as for the receiving an e-mail and parsing it... are you working in a
Microsoft Exchange environment?

 

[D.R.]

Hi neo,

Thanks very much for the feedback.

1) Can I use the "CDO for Windows 2000" library from VBScript (cscript)?
2) Yes we are working in an MS Exchange environment, Exchange 2003 (I
think?), but definitely not v5.5 and not 2007.

Thanks again,
Dave.

 

[neo [mvp outlook]]

1) Yes.

2) The reason I asked this question is that you can't use CDO for Windows
2000 to access a mailbox, but you can use Collaboration Data Objects*. This
library can be used from script and would allow you to access the internet
header.

* There are two flavors of this library. One ships with Outlook
(Collaboration Data Objects 1.21s) and contains the same security
enhancements as Outlook's object model. The other ships with Exchange
(Collaboration Data Objects 1.21). You want the library that ships with
Exchange in order to avoid the security enhancements.

 

[D.R.]

Hi neo,

I'm just wondering if I'm going about this the right way...

Is it possible to schedule/activate/embed a script within the MS Exchange
2000 server itself. I know that "rules" can be made to run in Outlook 2000
clients, and these can be scripts - but is it possible for MS Exchange 2000
Server to run it's own tasks/jobs/scripts?

Please could someone post a link to some online documentation for the CDO
1.21 (not 1.21s) object model, please? Thanks. Is the calling standard the
same? Is it just a case of ensuring that I copy the CDO 1.21 (not 1.21s)
library to the client/machine that my script will run on? Will I have
re-register (regsvr32) the DLL?

Thanks in advance.

Regards,
Dave.