需要错误消息：移至代码

Question

我有一个转移到代码。我遇到的问题是多个帐户的结果。确切地说，我有 3 个。

比方说 - 我的老板给我发了电子邮件，所以我从我的工作帐户跳转到我的个人帐户。我阅读了她的电子邮件，跳回到我的工作帐户和运行宏。它将她（最后 read/selected）移动到位置。我不知道我错误地移动了多少个人电子邮件，因为我忘记重新选择我要移动的正确电子邮件。

如何生成一条提示消息，说明我使用了错误的帐户以及我是否应该继续？注意：有时我可能需要继续。

附加信息：

帐户一： Chieri Thompson（个人）

帐户二： 艺术品电子邮件

帐户三： DesignProofsTAC（工作电子邮件 - 使用移动到宏的电子邮件）

根据设计证明 TAC 是： 收件箱（文件夹） 已完成（子文件夹）外包（子文件夹） .....

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

命名空间 class 提供 Accounts property which eturns an Accounts collection object that represents all the Account objects in the current profile. The Account class provides the DeliveryStore 属性其中 returns 代表帐户默认交付商店的商店对象。因此，您可以比较您选择商品的商店和您需要移动商品的帐户的默认商店。

此外，您可能会发现商店 class 的 GetDefaultFolder 方法很有用，它 returns 一个 Folder 对象，代表商店中的默认文件夹，并且是指定的类型通过 FolderType 参数。此方法类似于 NameSpace 对象的 GetDefaultFolder 方法。不同之处在于此方法获取与帐户关联的交付商店中的默认文件夹，而 NameSpace.GetDefaultFolder returns 当前配置文件的默认商店中的默认文件夹。

Answer 2

您可能会发现这比检查帐户更简单。

未测试代码：

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

需要错误消息：移至代码

Need Error Message: Move To code

outlook

vba