If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Search this Thread | Display Modes |
#1
|
|||
|
|||
Request for help with VBScript...
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 a 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_fso.OpenTextFile( 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 = " 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_fso.OpenTextFile( 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_fso.OpenTextFile( 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 |
Ads |
#2
|
|||
|
|||
Request for help with VBScript...
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." wrote in message ... 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 a 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_fso.OpenTextFile( 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 = " 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_fso.OpenTextFile( 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_fso.OpenTextFile( 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 |
#3
|
|||
|
|||
Request for help with VBScript...
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]" wrote in message ... 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." wrote in message ... 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 a 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_fso.OpenTextFile( 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 = " 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_fso.OpenTextFile( 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_fso.OpenTextFile( 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 |
#4
|
|||
|
|||
Request for help with VBScript...
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." wrote in message ... 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]" wrote in message ... 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." wrote in message ... 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 a 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_fso.OpenTextFile( 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 = " 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_fso.OpenTextFile( 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_fso.OpenTextFile( 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 |
#5
|
|||
|
|||
Request for help with VBScript...
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. "neo [mvp outlook]" wrote in message ... 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." wrote in message ... 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]" wrote in message ... 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." wrote in message ... 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 a 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_fso.OpenTextFile( 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 = " 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_fso.OpenTextFile( 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_fso.OpenTextFile( 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
VBSCRIPT Validate | Juls | Outlook - Using Forms | 4 | March 22nd 07 03:31 AM |
Meeting request is responded to by out of office request -shared c | Jeff Lowenstein | Outlook - Calandaring | 0 | October 30th 06 07:36 PM |
VBScript Create & Name a .pst | [email protected] | Outlook and VBA | 1 | September 18th 06 06:54 PM |
VBA or VBScript | goshute | Outlook and VBA | 1 | March 29th 06 01:01 AM |
Meeting request comes back undeliverable yet request is still rece | Sal F | Outlook - Calandaring | 0 | January 9th 06 05:32 PM |