Outlook delete condition not working for MeetingItem/AppointmentItem

[waubain]

I rarely write code and have little understanding of the Outlook objects. The following loops through specific folders and deletes messages based on conditions.

I am not getting any error messages, it just does not delete the message when I uncomment the conditional expression for the MeetingItem and ApppointmentItem and the condition has been met.

I do not think I have it properly Set = something
to access .Start of the MeetingItem

Public Sub DeleteUnwantedMail()
'This script loops through Delete Folder and deletes unwanted items
Dim ApptDate As Outlook.AppointmentItem
Dim MeetDate As Outlook.MeetingItem
Dim MeetItem As MeetingItem
Dim dtmToday As Date
Dim olItem As Outlook.Items
Dim intDays As Long
Dim x As Integer
Dim y As Integer

On Error GoTo errorhandler:

dtmToday = Date     'Assigns todays date to variable

Dim arrFolder(1 To 1) As Integer
 arrFolder(1) = 23   'Junk Folder -
 arrFolder(2) = 5     'Sent Items Folder
 arrFolder(3) = 3    'Deleted Items Folder

    'Loop through specific folders
    For x = LBound(arrFolder) To UBound(arrFolder)
        'Set folder to be current folder
        Set olItem = Application.GetNamespace("MAPI").GetDefaultFolder(arrFolder(x)).Items
        'Sort the folder descending order
        olItem.Sort "[Received]", True
            'Loops through each message type, determines message type and delete if criteria met
            For y = olItem.Count To 1 Step -1   'Set up loop
                'reset intDays
'                intDays = 0
                Select Case TypeName(olItem(y))
                    Case "MailItem"
                        If olItem(y).UnRead Then
                            olItem(y).Delete
                        Else
                          intDays = DateDiff("d", olItem(y).ReceivedTime, dtmToday)
                          If intDays >= 90 Then
                              olItem(y).Delete
                          End If
                        End If
                    Case "SharingItem"
                        If olItem(y).UnRead Then
                            olItem(y).Delete
                        End If
                    Case "MeetingItem"
                        'If olItem(y).Start < dtmToday Then
                            olItem(y).Delete
                        'End If
                    Case "AppointmentItem"
                        If olItem(y).Start < dtmToday Then
                            olItem(y).Delete
                        End If
                    Case Else
                        'For now skip over any message items not in case list
                End Select
            Next y
    Next x
        
' tidy up
Set olItem = Nothing

Exit Sub

errorhandler:
    
    If Err.Number = -2146893792 Then   'Encrypted message, cannot delete encrypted message with vba
        Resume Next
    'ElseIf Err.Number = ??? Then
    '    Resume Next
    'Else
    '    MsgBox "Error: " & Err.Number & " " & Err.Description, vbOKOnly, "Error Not Handled"
    '    Resume Next
    End If

End Sub

You don't know what you don't know...

 

[SkipVought]

Dim arrFolder(1 To [b]3[/b]) As Integer
 arrFolder(1) = 23   'Junk Folder -
 arrFolder(2) = 5     'Sent Items Folder
 arrFolder(3) = 3    'Deleted Item

 

[Andrzejek]

[tt](1 To [red]3[/red])[/tt] as Skip said, because your code:

Dim arrFolder(1 To 1) As Integer
arrFolder(1) = 23   [green]'Junk Folder -[/green]
arrFolder(2) = 5    [green]'Sent Items Folder[/green]
arrFolder(3) = 3    [green]'Deleted Items Folder[/green]

should give you an error: "9 - Subscript out of range" on line
[tt]arrFolder(2) = 5
[/tt]

Have fun.

---- Andy

A bus station is where a bus stops. A train station is where a train stops. On my desk, I have a work station.

 

[waubain]

Sorry, that was a typo. I was previously isolating the Sent folder trying to debug the problem and forgot to change back when I uncommented out the other 2 items in the array and pasted into the Thread. It does loop properly through all three folders of the array

The problem is still when it gets to a message that is a MeetingItem or AppointmentItem

You don't know what you don't know...

 

[waubain]

I found a link with the same problem and an answer.
Link

Here was the final code (not tested on all MeetingItem types)

Public Sub DeleteUnwantedMail()
'This script loops through Delete Folder and deletes unwanted items
Dim ApptItem As Outlook.AppointmentItem
Dim MeetItem As Outlook.MeetingItem

Dim dtmToday As Date
Dim olItem As Outlook.Items
Dim intDays As Long
Dim x As Integer
Dim y As Integer
Dim DateOfItem As Date

On Error GoTo errorhandler:

dtmToday = Date     'Assigns todays date to variable

Dim arrFolder(1 To 3) As Integer
 arrFolder(1) = 23  'Junk Folder"
 arrFolder(2) = 5   'Sent Items Folder
 arrFolder(3) = 3   'Deleted Items Folder

    'Loop through specific folders
    For x = LBound(arrFolder) To UBound(arrFolder)
        'Set folder to be current folder
        Set olItem = Application.GetNamespace("MAPI").GetDefaultFolder(arrFolder(x)).Items
        'Sort the folder descending order
        olItem.Sort "[Received]", True
            'Loops through each message type, determines message type and delete if criteria met
            For y = olItem.Count To 1 Step -1   'Set up loop
                Select Case TypeName(olItem(y))
                    Case "MailItem"
                        If olItem(y).UnRead Then
                            olItem(y).Delete
                        Else
                          intDays = DateDiff("d", olItem(y).ReceivedTime, dtmToday)
                          If intDays >= 90 Then
                              olItem(y).Delete
                          End If
                        End If
                    Case "SharingItem"
                        If olItem(y).UnRead Then
                            olItem(y).Delete
                          Else
                            intDays = DateDiff("d", olItem(y).ReceivedTime, dtmToday)
                            If intDays >= 10 Then
                              olItem(y).Delete
                            End If
                        End If
                    Case "MeetingItem"
                        Set MeetItem = olItem(y)
                        'Check if MeetingItem is a Meeting Request
                        If (MeetItem.MessageClass = "IPM.Schedule.Meeting.Request") Then
                            Set ApptItem = MeetItem.GetAssociatedAppointment(False)
                            DateOfItem = ApptItem.Start
                            Set ApptItem = Nothing
                        ElseIf (MeetItem.MessageClass = "IPM.Schedule.Meeting.Resp.Pos") Then
                            Set ApptItem = MeetItem.GetAssociatedAppointment(False)
                            DateOfItem = ApptItem.Start
                            Set ApptItem = Nothing
                        ElseIf (MeetItem.MessageClass = "IPM.Schedule.Meeting.Resp.Neg") Then
                            Set ApptItem = MeetItem.GetAssociatedAppointment(False)
                            DateOfItem = ApptItem.Start
                            Set ApptItem = Nothing
                        ElseIf (MeetItem.MessageClass = "IPM.Schedule.Meeting.Resp.Tent") Then
                            Set ApptItem = MeetItem.GetAssociatedAppointment(False)
                            DateOfItem = ApptItem.Start
                            Set ApptItem = Nothing
                        Else
                            ' Other MeetingItem
                            DateOfItem = MeetItem.ReceivedTime
                        End If
                        If DateOfItem <= dtmToday Then
                            olItem(y).Delete
                        End If
                        Set MeetItem = Nothing
                    Case "AppointmentItem"
                        Set ApptItem = olItem(y)
                        DateOfItem = ApptItem.Start
                        If DateOfItem <= dtmToday Then
                            olItem(y).Delete
                        End If
                    Case Else
                        MsgBox "Encountered a Message Type that cannot be handled", vbOKOnly + vbInformation, "Unknown Message Type"
                End Select
            Next y
    Next x
        
' tidy up
Set olItem = Nothing

Exit Sub

errorhandler:
    
    If Err.Number = -2146893792 Then   'Encrypted message, cannot delete encrypted message with vba
        Resume Next
    'ElseIf Err.Number = ??? Then
    '    Resume Next
    Else
        MsgBox "Error: " & Err.Number & " " & Err.Description, vbOKOnly, "Error Not Handled"
        Resume Next
    End If

End Sub

You don't know what you don't know...