Help changing flag on messsages older than a certain date

K

Kevin

Using Outlook 2000, I'm trying to write a macro that searches through
messages in the inbox and, if they are older than 01/30/2005 and flagged for
follow up, I want to flag them complete.

I've tried several approaches but don't seem to be getting anywhere. Does
anyone have some code that can do this?

Thanks.

Kevin
 
E

Eric Legault [MVP - Outlook]

Try the code below. Just change anything you need to in the calling MyMacro
procedure:

Sub MyMacro()
On Error GoTo MyMacro_Error

Dim objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate objInbox,
#01/30/2005#

Set objNS = Nothing
Set objInbox = Nothing

On Error GoTo 0
Exit Sub

MyMacro_Error:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure MyMacro of VBA Document ThisOutlookSession"
Resume Next
End If
End Sub

Sub SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate(MailFolder
As Outlook.MAPIFolder, BeforeDate As Date)
On Error GoTo
SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate_Error

Dim objItems As Outlook.Items, objMailItem As Outlook.MailItem
Dim strCriteria As String

strCriteria = "[ReceivedTime] <= """ & BeforeDate & """ AND
[FlagRequest] = 'Follow up' AND [FlagStatus] <> 1"
Set objItems = MailFolder.Items.Restrict(strCriteria)

For Each objMailItem In objItems
objMailItem.FlagStatus = olFlagComplete
objMailItem.Save
Next

On Error GoTo 0
Exit Sub

Set objItems = Nothing
Set objMailItem = Nothing

SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate_Error:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate of VBA
Document ThisOutlookSession"
Resume Next
End If
End Sub
 
K

Kevin

Eric,

Thanks for the prompt reply. I see from your code that I was missing a few
key components in my own code. Yours is better! I'll save my grumblings on
the lack of good documentation and my own lack of prowess.

That said, when I run your code, it indeed processes a bunch of messages
but, for some reason, not all. Each time I run the code it processes some
more. Any insight as to why this might be? Your code does not generate any
errors when I run it.

Thanks

Kevin

Eric Legault said:
Try the code below. Just change anything you need to in the calling MyMacro
procedure:

Sub MyMacro()
On Error GoTo MyMacro_Error

Dim objInbox As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace

Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate objInbox,
#01/30/2005#

Set objNS = Nothing
Set objInbox = Nothing

On Error GoTo 0
Exit Sub

MyMacro_Error:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure MyMacro of VBA Document ThisOutlookSession"
Resume Next
End If
End Sub

Sub SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate(MailFolder
As Outlook.MAPIFolder, BeforeDate As Date)
On Error GoTo
SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate_Error

Dim objItems As Outlook.Items, objMailItem As Outlook.MailItem
Dim strCriteria As String

strCriteria = "[ReceivedTime] <= """ & BeforeDate & """ AND
[FlagRequest] = 'Follow up' AND [FlagStatus] <> 1"
Set objItems = MailFolder.Items.Restrict(strCriteria)

For Each objMailItem In objItems
objMailItem.FlagStatus = olFlagComplete
objMailItem.Save
Next

On Error GoTo 0
Exit Sub

Set objItems = Nothing
Set objMailItem = Nothing

SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate_Error:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure SearchFolderForMessagesFlaggedForFollowUpBeforeSpecifiedDate of VBA
Document ThisOutlookSession"
Resume Next
End If
End Sub

--
Eric Legault - B.A, MCP, MCSD, Outlook MVP
--
Try Picture Attachments Wizard for Outlook!
http://tinyurl.com/9bby8
--
Job: http://www.imaginets.com
Blog: http://blogs.officezealot.com/legault/


Kevin said:
Using Outlook 2000, I'm trying to write a macro that searches through
messages in the inbox and, if they are older than 01/30/2005 and flagged for
follow up, I want to flag them complete.

I've tried several approaches but don't seem to be getting anywhere. Does
anyone have some code that can do this?

Thanks.

Kevin
Click to expand...
Click to expand...
 
K

Ken Slovak - [MVP - Outlook]

To jump in on Eric's thread, use a down counting For loop. As each item is
removed from the collection as it's marked complete the For loop index is
being messed with.

For i = objItems.Count To 1 Step -1
Set objMailItem = objItems(i)
objMailItem.FlagStatus = olFlagComplete
objMailItem.Save
Next

Same thing applies when you delete or otherwise change the collection size
downward.
 
K

Kevin

Thanks for stepping in to resolve this Ken. I should have realized that
this was the case.

Cheers!

Kevin
 
Top