Outlook Rules, Running Script, Delaying Emails

[dwichmann]

Hi All

I have some Outlook Rules set up that run a script that ive written. The script launches Excel and Updates a number of spreadsheets. We have a slave machine and this allows users to email the machine with a pre set word, this launches the code, updates the spreadsheets, job done.

The issue im having is that inside the script I have a command to send an email to a distribution list to tell that that scripts are running. Another email is sent at the end.

It appears that becuase the scripts are running through an outlook rule, the two emails are not sent until the rule completes. If i step my code through it all works perfectly.

I hope ive explained it well enough, any help is massively appreciated.

Sub RunAScriptRuleRoutineSchedule9(MyMail As MailItem)
Dim xlapp As Object
Dim sourceWB As Workbook
Dim pathname As String
Dim Subjectname As String
Dim objol As New Outlook.Application
Dim objmail As MailItem
Dim ToName As String
Dim CCName As String
Dim filename As String
Dim senderaddress As String
Dim objol1 As New Outlook.Application
Dim objmail1 As MailItem

Set objol = New Outlook.Application
Set objmail = objol.CreateItem(olMailItem)

Subjectname = "Excel Updates Started"
ToName = "me@me.com"

With objmail
.To = ToName
.CC = CCName
.Subject = Subjectname
.Body = "Excel updates have been started"
.NoAging = True
.Display
.Send
End With

Set objmail = Nothing
Set objol = Nothing

Set xlapp = CreateObject("Excel.Application")
With xlapp
.Visible = True
.EnableEvents = False
End With
strfile = "C:\Sharepoint List For Automation V3.xlsm"
filename = "Sharepoint List For Automation V3.xlsm"

Set sourceWB = xlapp.Workbooks.Open(strfile, , False, , , , , , , True)
sourceWB.Activate
sourceWB.Application.Wait (Now + TimeValue("00:00:10"))
xlapp.Run "RunScheduleNumber9"

sourceWB.Close False

xlapp.Quit
Set xlapp = Nothing

Set objol1 = New Outlook.Application
Set objmail1 = objol1.CreateItem(olMailItem)

Subjectname = "Excel Updates Completed"
ToName = "me@me.com"

With objmail1
.To = ToName
.CC = CCName
.Subject = Subjectname
.Body = "Excel updates have now completed. The following spreadsheets failed: " & error_list
.NoAging = True
.Display
.Send
End With
Set objmail1 = Nothing
Set objol1 = Nothing

End Sub