2011-06-30 34 views
0

正如標題中所述,我正試圖防止Outlook中的harddeleting項目。我能夠捕捉BeforeItemMove事件中的操作。然後,用戶可以選擇是繼續還是取消。如果他決定繼續,則應將項目移至「已刪除郵件」文件夾,而不是永久刪除。使用VBA將Outlook中的硬刪除項目重定向到已刪除項目

我的第一個想法是取消刪除操作,通過將取消設置爲True,然後將項目移動到已刪除郵件文件夾。問題是,事件再次爲移動操作觸發,但是交付的對象似乎以某種方式被破壞。我試着在刪除的項目上設置一個UserProperty,然後移動它。但在事件子的「第二次運行」中,當我嘗試讀取prop時,發現運行時錯誤,指出無法找到消息。

S.O.幫幫我?

這裏是所涉及的兩個事件處理程序:

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 

奇怪的是,對於oTasks第一事件處理的工作正是我想要的方式運行。該項目被移至已刪除的項目,並且該事件處理程序僅被調用一次。 oAppointments的第二個會被調用兩次而沒有Tim對inProgress-if-clause的建議......而真正奇怪的是,在第二個事件處理程序中,該項目被移動到草稿而不是刪除項目,但是oDeletedItems-Object在兩者之間沒有改變...任何想法?我不喜歡VBA!

+0

總是有助於顯示您的實際代碼... –

回答

1

我會建議你使用

Application.EnableEvents=False 

你移動的ITAM之前暫時禁用事件,但檢查它似乎有在Outlook VBA沒有這樣的事情。另一種方法是使用靜態變量來允許跳過移動事件。

Intested僞代碼:

Sub SomeEventHandler() 

    Static inProcess as Boolean 

    If inProcess then Exit Sub 

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

End Sub 
+0

謝謝,這有一些調整工作。我不得不將inProgress = false移動到第一個if子句。看起來,事件處理者在開始新事物之前完成整個子事務。但仍然存在問題。出於某種原因,該項目被移動到草稿,而不是刪除項目,儘管移動方法參數返回刪除項目...另一個事件處理程序,具有完全相同的代碼工作正常,即使沒有inProgress部分它只被調用一次。 ..工作的是TaskItems和失敗的AppointmentItems。任何想法如何可能? – Tobi

+0

我已將兩個事件處理程序添加到原始問題 – Tobi

+0

對不起 - Outlook編程不是我的事情:我無法提供任何建議,爲什麼約會在草稿中結束 –

0

我認爲調用oAppointment.SaveAppointmentItem保存到當前文件夾這大概是Drafts。先前調用oAppointment.Move oDeletedItems不會更改當前文件夾。

您確定需要保存oAppointment,因爲您不在其他事件處理程序中保存oTask