CODEWITHSUNDEEP
vbaoutlook
Tobi
Tobi

Reputation: 5519

Redirecting hard-deleted items in Outlook to Deleted Items with VBA

As said in the title I'm trying to prevent harddeleting Items in Outlook. I am able to catch the operation in the BeforeItemMove-event. Then the user is given a choice whether to proceed or cancel. If he decides to proceed, the item should be moved to the Deleted Items Folder and not be deleted permanently.

My first idea was to cancel the delete-operation by setting Cancel to True and then moving the item to the Deleted Items folder. The problem is, that the event fires again for the move operation, but the handed item-object seems to be broken somehow. I tried setting a UserProperty on the deleted item and then moving it. but in the "second run" of the event-sub when i try to read the prop, i get a runtime-error saying the message could not be found.

Can S.O. help?

Here are the two event-handlers involved:

    Private Sub oTasks_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As Folder, Cancel As Boolean)

    Dim shouldDelete As Boolean
    shouldDelete = False

    Dim hardDeletePerformed
    hardDeletePerformed = False


    If (MoveTo Is Nothing) Then
        shouldDelete = True
        hardDeletePerformed = True
    ElseIf (g_oNS.CompareEntryIDs(MoveTo.EntryID, oDeletedItems.EntryID)) Then
        shouldDelete = True
    End If

    Dim oTask As TaskItem
    Set oTask = Item




    If shouldDelete Then
        If (InStr(1, oTask.Subject, "frist", vbTextCompare)) Then
            Dim message As String
            message = "..."
            Dim res As VbMsgBoxResult

            res = MsgBox(message, vbOKOnly + vbCritical, "Compliance-Warnung!")
            Cancel = True
        Else
            Dim message2 As String
            message2 = "..."

            Dim res2 As VbMsgBoxResult

            res2 = MsgBox(message2, vbYesNo + vbCritical, "Compliance-Warnung!")
            If (res2 = vbYes) Then
                Cancel = False
                If hardDeletePerformed Then
                    oTask.Move oDeletedItems
                    Cancel = True
                End If
            Else
                Cancel = True
            End If
        End If
    End If
End Sub

    Private Sub oAppointments_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As Folder, Cancel As Boolean)


        If inProgress Then
            Cancel = True
            inProgress = False
        Else



        Dim shouldDelete As Boolean
        shouldDelete = False

        Dim hardDeletePerformed
        hardDeletePerformed = False


        If (MoveTo Is Nothing) Then
            shouldDelete = True
            hardDeletePerformed = True
        ElseIf (g_oNS.CompareEntryIDs(MoveTo.EntryID, oDeletedItems.EntryID)) Then
            shouldDelete = True
        End If

        Dim oAppointment As AppointmentItem
        Set oAppointment = Item


        If shouldDelete Then
            If (InStr(1, oAppointment.Subject, "frist", vbTextCompare)) Then
                Dim message As String
                message = "..."
                Dim res As VbMsgBoxResult

                res = MsgBox(message, vbOKOnly + vbCritical, "Compliance-Warnung!")
                Cancel = True
            Else
                Dim message2 As String
                message2 = "..."

                Dim res2 As VbMsgBoxResult

                res2 = MsgBox(message2, vbYesNo + vbCritical, "Compliance-Warnung!")
                If (res2 = vbYes) Then
                    Cancel = False
                    If hardDeletePerformed Then
                        inProgress = True
                        oAppointment.Move oDeletedItems
                        oAppointment.Save
                        'inProgress = False
                        Cancel = True
                    End If
                Else
                    Cancel = True
                End If
            End If
        End If

        End If

    End Sub

The weird thing is, the first eventhandler for oTasks works exactly the way i want it to. The item is moved to deleted items and the eventhandler is called only once. the second for oAppointments would get called twice without Tims suggestions for the inProgress-if-clause... and whats realy weird is, that in the second eventhandler, the item gets moved to Drafts and not to Deleted Items, but the oDeletedItems-Object is not changed in between... Any ideas?

PS: I hate VBA!

Upvotes: 0

Views: 861

Answers (2)

barrowc
barrowc

Reputation: 10679

I think that calling oAppointment.Save will save the AppointmentItem to the current folder which presumably is Drafts. The previous call to oAppointment.Move oDeletedItems doesn't change the current folder.

Are you sure that you need to save oAppointment because you don't save oTask in the other event handler?

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166146

I was going to suggest you use 

Application.EnableEvents=False

to temporarily disable events before you moved the itam, but on checking it seems there's no such thing in OutLook VBA. An alternative would be to use a static variable to allow the Move event to be skipped.

Intested pseudocode:

Sub SomeEventHandler()

   Static inProcess as Boolean

   If inProcess then Exit Sub

   If IsHardDelete then
      inProcess = True
      'move item
      inProcess = False
   End If

End Sub

Upvotes: 1

Related Questions