Outlook Rules not working

[TheGuptes]

I get bout 8 to 10 reports from TeamBinder daily, and need to manually click on a link in the email to download the reports.


I am trying to automate the process by using a Rule and a script.


The rule works, and the script (run manually) works, and the Rule runs the script (tested by displaying a MSGBox), and sometimes the script (run by the Rule) downloads the report, and sometimes it does not.


I can not figure out why.


I am using Outlook 2010.

The script (in Microsoft Outlook Objects section, ThisOutlookSession sub section):


Private Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal Operation As String, _
ByVal Filename As String, _
Optional ByVal Parameters As String, _
Optional ByVal Directory As String, _
Optional ByVal WindowStyle As Long = vbMinimizedFocus _
) As Long

' ThisOutlookSession

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)

Sub OpenLinksMessage(Item As Outlook.MailItem)
Dim InspectMail As Outlook.MailItem
Dim olMail As Outlook.MailItem
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Dim strURL As String
Dim lSuccess As Long

' MsgBox ("ThisOutlookSession Running")

' Set InspectMail = olMail.GetInspector.CurrentItem

' Application.Wait (Now + TimeValue("0:00:20"))

' Sleep 20000

' Threading.thread.Sleep (20000)


Set olMail = Application.ActiveExplorer().Selection(1)

Set Reg1 = New RegExp

With Reg1
.Pattern = "Web site link here"
.Global = False
.IgnoreCase = True
End With

If Reg1.TEST(olMail.Body) Then
Set M1 = Reg1.Execute(olMail.Body)
For Each M In M1
strURL = M.SubMatches(0)
Debug.Print strURL
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
lSuccess = ShellExecute(0, "Open", strURL)
DoEvents
NextURL:
Next
End If

' MsgBox ("ThisOutlookSession End")

Set Reg1 = Nothing

' MsgBox ("ThisOutlookSession End")

End Sub

Continue reading...