Outlook VBA - Item.Moveプロシージャはランダムに失敗します

Question

以下のコードがあります。

問題は、他のすべてが完全に機能する（カテゴリが割り当てられ、正常に保存される）場合があります。ランダムに、電子メールが移動しないことがあります。私は多くを検索し、解決策を考え出すことができませんでした。多分誰かが助けることができます。これはメールアイテムやその他のタイプに関係なく発生し、特定のフォルダではなくランダムに発生します。時には、同じ電子メールで何度も試してみると、それは動いてしまいます。どんな助けもありがとう！どのようなコードが行うことになっていることである

： 1）メールのコードは最初のカテゴリ 4を割り当て人のユーザー名で別のカテゴリを追加して進ん） 2）ユーザーは、カテゴリ 3を割り当てて到着した）メール収入を正確にモジュールの上部に明示

Private WithEvents myOlItems As Outlook.Items 

Public Sub Application_Startup() 
    Set myOlItems = GetFolder("SHARED MAILBOX NAME\Inbox").Items 
End Sub 

Private Sub myOlItems_ItemChange(ByVal Item As Object) 
    If Not Item Is Nothing Then 
     Dim status As Outlook.UserProperty 
     Set status = Item.UserProperties.Find("Processed") 
     If Not Item Is Nothing Then 
      On Error Resume Next 
      Cat = Item.Categories 
      On Error GoTo 0 
     End If 
     On Error Resume Next 
     If Cat <> "" And status <> "True" And Not Cat Is Nothing Then 
      If Len(Cat) > 0 Then 
       user = Application.GetNamespace("MAPI").CurrentUser 
       user = Replace(user, ",", " ") 
       Item.Categories = Cat & ";Category " & Cat & " assigned by: " & user 
       status.Value = "True" 
       Item.Save 
       Item.Move (GetFolder("SHARED MAILBOX\Inbox").Folders("Subfolder name").Folders(Cat)) 
       Cat = Nothing 
       status = Nothing 
       Set myOlItems = GetFolder("SHARED MAILBOX NAME\Inbox").Items 
      End If 
     ElseIf Cat = "" And status = "True" Then 
      status.Value = "False" 
      status = Nothing 
      Cat = Nothing 
     End If 
     On Error GoTo 0 
    End If 
End Sub 

Answer 1

プット・オプションを割り当てられたカテゴリとしてという名前のフォルダに移動しますします。 Catを文字列変数として宣言します。すべてのCat = Nothingコードを削除する必要があります。

第2を削除します。On Error Resume Next行が削除されると、Set Status = Nothingが必要です。どのように役立つかが分かるまで、エラーをOn Error Resume Nextで隠すのは避けてください。エラー処理の情報はこちらhttp://www.cpearson.com/excel/errorhandling.htm

これは確実にあなたが望むことを行う可能性があります。

Option Explicit ' At the top of the module 

Private Sub myOlItems_ItemChange(ByVal Item As Object) 

    Dim Cat As String 
    Dim uSer As String 

    If Not Item Is Nothing Then 

     Dim status As Outlook.UserProperty 
     Set status = Item.UserProperties.Find("Processed") 

     If Not Item Is Nothing Then 
      On Error Resume Next 'This line does nothing 
      Cat = Item.Categories 
      On Error GoTo 0 
     End If 

     ' http://www.cpearson.com/excel/errorhandling.htm 
     'On Error Resume Next 

     'If Cat <> "" And status <> "True" And Not Cat Is Nothing Then 
     If Cat <> "" And status <> "True" Then 

      If Len(Cat) > 0 Then 

       uSer = Application.GetNamespace("MAPI").CurrentUser 
       uSer = Replace(uSer, ",", " ") 
       Item.Categories = Cat & ";Category " & Cat & " assigned by: " & uSer 
       status.Value = "True" 
       Item.Save 
       Item.move (GetFolder("SHARED MAILBOX\Inbox").folders("Subfolder name").folders(Cat)) 
       'Cat = Nothing 

       ' status = Nothing 
       Set status = Nothing 

       'Set myOlItems = GetFolder("SHARED MAILBOX NAME\Inbox").items 

      End If 

     ElseIf Cat = "" And status = "True" Then 
      status.Value = "False" 
      'status = Nothing 
      Set status = Nothing 
      'Cat = Nothing 

     End If 

     'On Error GoTo 0 

    End If 

End Sub