J
James H
When new mail is received, I want to scan inbox for
messages with a phrase in it and delete all of them except
the last one. So I wrote the code below, but it doesn't
execute when new mail comes in.
I tested the code by pasting it into a regular macro and
tracing it, and it works when I explicitly trigger it. It
just doesn't run automatically.
What else do I have to do?
James
Dim WithEvents myOlApp As Outlook.Application
Sub Initialize_handler()
Set myOlApp = CreateObject("Outlook.application")
End Sub
Private Sub myOlApp_NewMail()
Dim myFolder As Outlook.MAPIFolder
Dim HourlyPendings(200) As MailItem
Dim LatestTime As Date
Set myFolder = myOlApp.GetNamespace
("MAPI").GetDefaultFolder(olFolderInbox)
' search for latest "hourly pendings"
j = 0
LatestTime = #1/1/1950#
For i = 1 To myFolder.Items.Count
If InStr(myFolder.Items(i), "Hourly Pendings") > 0
Then
j = j + 1
HourlyPendings(j) = myFolder.Items(i)
If myFolder.Items(i).ReceivedTime > LatestTime
Then LatestTime = myFolder.Items(i).ReceivedTime
End If
Next i
' now delete all except latest
For i = 1 To j
If HourlyPendings(i).ReceivedTime < LatestTime Then
HourlyPendings(i).Delete
End If
Next i
End Sub
messages with a phrase in it and delete all of them except
the last one. So I wrote the code below, but it doesn't
execute when new mail comes in.
I tested the code by pasting it into a regular macro and
tracing it, and it works when I explicitly trigger it. It
just doesn't run automatically.
What else do I have to do?
James
Dim WithEvents myOlApp As Outlook.Application
Sub Initialize_handler()
Set myOlApp = CreateObject("Outlook.application")
End Sub
Private Sub myOlApp_NewMail()
Dim myFolder As Outlook.MAPIFolder
Dim HourlyPendings(200) As MailItem
Dim LatestTime As Date
Set myFolder = myOlApp.GetNamespace
("MAPI").GetDefaultFolder(olFolderInbox)
' search for latest "hourly pendings"
j = 0
LatestTime = #1/1/1950#
For i = 1 To myFolder.Items.Count
If InStr(myFolder.Items(i), "Hourly Pendings") > 0
Then
j = j + 1
HourlyPendings(j) = myFolder.Items(i)
If myFolder.Items(i).ReceivedTime > LatestTime
Then LatestTime = myFolder.Items(i).ReceivedTime
End If
Next i
' now delete all except latest
For i = 1 To j
If HourlyPendings(i).ReceivedTime < LatestTime Then
HourlyPendings(i).Delete
End If
Next i
End Sub