VB6 Email using CDO, Locking Up Problem

[PCHarry]

I have been using the below VB6 code to send basic text email messages every 30 minutes, program runs continuously. Code has been running successfully on numerous PC systems (WinXP, SP3) when transmitting emails connected to a land based LAN. When sending via a satellite based comms link (where comms speeds are noticeably slower), the SW can lock up in the “.SEND” process. Occurs about once a day. Have to use TaskManager to completely shutdown program before restarting.

On Error GoTo cAppMsg_SendEmailError

With cdoConf.Fields
	.item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	.item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Email.SMTPserver
	.item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

	.item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
	.item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

	If (Email.Username = "") Then
		.item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
	Else
		.item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
		.item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Email.Password
		.item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Email.Username
	End If

	.Update
End With

With cdoMsg
	Set .Configuration = cdoConf
	.To = Email.ToAddress
	.from = Email.fromAddress
	.Subject = Email.Subject
	.TextBody = strBody
	.BCC = ""
	.CC = ""
	.Send
End With

Set cdoMsg = Nothing
Set cdoConf = Nothing

The main problem appears to be that the timeout function (currently = 60 secs) does not appear to work in all circumstances! If possible I would prefer to be able to fix this problem from within the VB program itself. ie. If the email CDO program does not return then a new procedure would be run to kill it, and then continue on.

Is there some way to do this from within a VB program?

Thks for yr help.