Нужно сообщение об ошибке: Переместить код

Question

У меня есть переход к коду. Проблема, с которой я столкнулась, - результат нескольких учетных записей. У меня 3, чтобы быть точным.

Скажем, мой босс отправил мне электронное письмо, поэтому я перехожу с моей учетной записи на мой личный счет. Я прочитал ее электронную почту, вернусь к своей учетной записи и запустил макрос. Он перемещает ее (последнее чтение/выбор) в местоположение. Я не знаю, сколько личных писем я переместил по ошибке, потому что забыл переизбрать правильную электронную почту, которую я хотел переместить.

Как я могу создать оперативное сообщение о том, что я ошибаюсь, и если я продолжу? Примечание: могут быть случаи, когда мне может понадобиться продолжить.

Дополнительная информация:

счет Один: Киери Томпсон (Personal)

счета Два: Artwork Письмо

счет Три: DesignProofsTAC (работа по электронной почте - один используя переход на макрос)

проектируемых ТАСОВ Доказательства: Входящих (папка) Завершено (вложенный) Outsourced (вложенный) .....

Private Sub CommandButton7_Click() 'COMPLETED 

On Error Resume Next 
Dim ns As Outlook.NameSpace 
Dim MoveToFolder As Outlook.MAPIFolder 
Dim objItem As Outlook.MailItem 

Set objItem = objApp.ActiveInspector.CurrentItem 
Set ns = Application.GetNamespace("MAPI") 
Set MoveToFolder = ns.Folders("designproofstac").Folders("Inbox").Folders("3_COMPLETED") 

If Application.ActiveExplorer.Selection.Count = 0 Then 
    MsgBox ("Not in Correct Folder") 
    Exit Sub 
End If  
' this is the error code I want to produce the "you are in wrong account - proceed anyway?" DesignProofsTAC should be "default" i guess. 

If MoveToFolder Is Nothing Then 
    MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "Move Macro Error" 
End If 

For Each objItem In Application.ActiveExplorer.Selection 
    If MoveToFolder.DefaultItemType = olMailItem Then 
     If objItem.Class = olMail Then 
      objItem.Move MoveToFolder 
     End If 
    End If 
Next 

Set objItem = Nothing 
Set MoveToFolder = Nothing 
Set ns = Nothing 

End Sub 

Answer 1

Это может быть проще, чем проверка счетов.

Непроверено Код:

Option Explicit 

Sub MoveOpenMail 'COMPLETED 

' Place a button on the Quick Access Toolbar for an item opened for reading. 

    Dim ns As NameSpace 
    Dim MoveToFolder As Folder 
    Dim objItem As object ' <--- May not be a mailitem 

    Set ns = Application.GetNamespace("MAPI") 


    ' Do not use On Error Resume Next 
    ' unless there is a specific purpose 
    ' and it is quickly followed by On Error GoTo 0 
    On Error Resume Next 
    Set MoveToFolder = ns.Folders("designproofstac").Folders("Inbox").Folders("3_COMPLETED") 
    On Error GoTo 0 
    If MoveToFolder Is Nothing Then 
     MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "MoveOpenMail VBA Error" 
     GoTo ExitRoutine 
    End If 

    On Error Resume Next 
    Set objItem = ActiveInspector.CurrentItem 
    On Error GoTo 0 
    If objItem Is Nothing Then 
     MsgBox "Use this code when there is an open mailitem!", vbOKOnly + vbExclamation, "MoveOpenMail VBA Error" 
     GoTo ExitRoutine 
    End If 

    If MoveToFolder.DefaultItemType = olMailItem Then 

     If objItem.Class = olMail Then 
      objItem.Move MoveToFolder 
     End If 

    Else 
     MsgBox "Target folder is wrong type!", vbOKOnly + vbExclamation, "MoveOpenMail VBA Error" 

    End If 

ExitRoutine: 
    Set ns = Nothing 
    Set MoveToFolder = Nothing 
    Set objItem = Nothing 

End Sub 



Sub MoveSelectedMail 'COMPLETED 

' Place a button on the Quick Access Toolbar for an open folder 

    Dim ns As NameSpace 
    Dim MoveToFolder As Folder 
    Dim objItem as Object 

    Dim objExplorer As Explorer 
    Dim objSelection As Object 
    Dim x as Long 

    Set ns = Application.GetNamespace("MAPI") 

    On Error Resume Next 
    Set MoveToFolder = ns.Folders("designproofstac").Folders("Inbox").Folders("3_COMPLETED") 
    On Error GoTo 0 
    If MoveToFolder Is Nothing Then 
     MsgBox "Target folder not found!", vbOKOnly + vbExclamation, "MoveSelectedMail VBA Error" 
     GoTo ExitRoutine 
    End If 

    Set objExplorer = ActiveExplorer 
    Set objSelection = objExplorer.Selection 

    If objSelection.Count = 0 Then 

     MsgBox "Select one or more mailitems" 
     GoTo ExitRoutine 

    Else 

     If MoveToFolder.DefaultItemType = olMailItem Then 

      ' Do not use For Each 
      ' Count backwards when moving or deleting 
      For x = objSelection.Count to 1 step -1 
       Set objItem = objSelection.Item(x) 
       If objItem.Class = olMail Then 
        objItem.Move MoveToFolder 
       End If 
      Next x 

     Else 
      MsgBox "Target folder is wrong type!", vbOKOnly + vbExclamation, "MoveSelectedMail VBA Error" 

     End If 

    End If  

ExitRoutine: 
    Set ns = Nothing 
    Set MoveToFolder = Nothing 
    Set objItem = Nothing 

    Set objExplorer = Nothing 
    Set objSelection = Nothing 

End Sub 

Answer 2

Класс Пространства имен обеспечивает Accounts свойства который выдает объект коллекции учетных записей, который представляет все объекты Account в текущем профиле. Класс Account предоставляет свойство DeliveryStore, которое возвращает объект Store, который представляет хранилище доставки по умолчанию для учетной записи. Таким образом, вы можете сравнить Store, в котором вы выбрали элемент и хранилище по умолчанию для учетной записи, которую необходимо переместить.

Также вы можете найти способ класса Store GetDefaultFolder полезным, он возвращает объект Folder, который представляет собой папку по умолчанию в хранилище и имеет тип, указанный аргументом FolderType. Этот метод аналогичен методу GetDefaultFolder объекта NameSpace. Разница в том, что этот метод получает папку по умолчанию в хранилище доставки, связанную с учетной записью, тогда как NameSpace.GetDefaultFolder возвращает папку по умолчанию в хранилище по умолчанию для текущего профиля.