Question

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

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

如何生成一条提示信息，说明我在错误的帐户中，是否应该继续？注意：有时我可能需要继续。

其他信息：

第一帐户：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

Namespace类提供Accounts属性，该属性包含一个Accounts集合对象，该对象表示当前配置文件中的所有Account对象。 Account类提供DeliveryStore属性，该属性返回一个Store对象，该对象表示该帐户的默认交付商店。因此，您可以比较您选择商品的商店和移动商品所需帐户的默认商店。

此外，您可能会发现Store类的GetDefaultFolder方法很有用，它会返回一个Folder对象，该对象表示存储中的默认文件夹，并且是FolderType参数指定的类型。此方法类似于NameSpace对象的GetDefaultFolder方法。区别在于此方法获取与该帐户关联的传递存储上的默认文件夹，而NameSpace.GetDefaultFolder返回当前配置文件的默认存储上的默认文件夹。

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

需要错误信息：移动到代码

2 个答案: