Outlook VBA - Item.Move 프로 시저가 임의로 실패 함

Question

아래 코드가 있습니다.

문제는 그 밖의 모든 것이 완벽하게 작동하지만 (범주가 할당되고 성공적으로 저장 됨), 때로는 임의로 전자 메일이 이동하지 않는다는 것입니다. 나는 많은 것을 검색해 보았고 해결책을 찾을 수 없었습니다. 어쩌면 누군가가 도울 수 있습니다. 이것은 mailitem 또는 다른 유형과 관계없이 발생하며 특정 폴더가 아닌 임의로 발생합니다. 때로는 동일한 전자 메일을 여러 번 사용하면 이동이 끝나는 경우가 있습니다. 어떤 도움을 주셔서 감사합니다! 코드가 어떻게해야 무엇

은 다음과 같습니다 1) 이메일이 2) 사용자가 3) 코드는 첫 번째 범주를 4) 이메일을 할당 된 사람의 사용자 이름과 다른 카테고리를 추가로 진행 카테고리를 할당 도착 카테고리 모듈의 상단에 명시

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을 String 변수로 선언하십시오. Cat = Nothing 코드를 모두 삭제해야합니다.

두 번째를 제거하십시오 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