处理电子邮件时切换电子邮件帐户

Question

所以我有多个收件箱，我需要从中处理邮件。我试图遍历它们并找到必要的邮箱和文件夹，以将邮件移出。当我到达“对于 Outlook 中的每个 oAccount ...”时，它告诉我“需要对象”。我正在了解如何使其在帐户中循环。如果有人能告诉我我在下面的代码中出错的地方，我将非常感激。

谢谢！

Sub MoveEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object
    Dim Br, Spec As Folder
    Dim oOlAtch As Object
    Dim eSender As String, dtRecvd As String, dtSent As String, o0Acct1 As String, o0Acct2 As String
    Dim sSubj As String, sMsg As String
    Dim wb As Workbook, wb2 As Workbook
    Dim fso As FileSystemObject
    Dim FName, NewFileName As String
    Dim sn As String

    'Set objects

    '~~> Get Outlook instance
    o0Acct1 = "Me@abc"
    o0Acct2 = "AlsoMe@abc"
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
    Set Br = oOlInb.Folders("Folder1")
    Set Sp = oOlInb.Folders("Folder2")
    Set oOlItm = Br.Items

'=====================================================

For Each oAccount In oOutlook.Sessions.Accounts
    If oAccount = o0Acct1 Then

        Dim i As Integer
        For i = Br.Items.Count To 1 Step -1   'loop goes from last to first element
            sn = Br.Items(i).SenderName

            If sn = "Them@abcd" Then
                Set dest = Sp
                Br.Items(i).Move dest

            Else
            End If
        Next
    Else
    End If
Next

End Sub

' =============================================== ==============================

好的，我已经解决了。我没有尝试循环浏览帐户，而是循环浏览了不同命名空间中的文件夹。我可以使用下面的代码循环到正确的帐户和文件夹。谢谢！

Sub List_All_NameSpace_Folders()
    Dim myNS As Namespace
    Dim i As Integer
    Dim sn As String

    Set myNS = GetNamespace("MAPI")
    With myNS
        For Each Folder In myNS.Folders

            If Folder = "Email@abc" Then
                Set Br = Folder.Folders("Inbox").Folders("Folder1")
                Set Cl = Folder.Folders("Inbox").Folders("Folder1").Folders("Folder2")

                For i = Br.Items.Count To 1 Step -1   'loop goes from last to first element
                        sn = Br.Items(i).SenderName
                         If sn = "Email2@abc" Then
                            Set dest = Cl
                            Br.Items(i).Move dest

                        Else
                        End If
                Next

            Else
            End If
        Next Folder
    End With
End Sub

Answer 1

正如您在评论中指出的那样，您只有一个帐户，因此您无法更改帐户。

在您的工作解决方案中，您会找到一个名为 Email@abc 的文件夹，它是您帐户中的一个电子邮件地址。

无论Br文件夹是否在默认收件箱中，您都可以直接引用该文件夹，很长的路要走，不用.GetDefaultFolder。

而不是循环浏览文件夹：

Sub referenceOneOfManyEmailAddressesInSingleAccount()

    Dim myNS As Namespace
    Dim emFldr as folder
    Dim inbxFldr as folder
    Dim Br as folder
    Dim dest as folder

    Dim i As Long
    Dim sn As String

    Set myNS = GetNamespace("MAPI")
    Set emFldr = myNS.Folders("Email@abc")
    Set inbxFldr = emFldr.Folders("Inbox")

    Set Br = inbxFldr.Folders("Folder1")
    Set dest = Br.Folders("Folder2")

    For i = Br.Items.Count To 1 Step -1   'loop goes from last to first element
        sn = Br.Items(i).SenderName
        If sn = "Email2@abc" Then
            Br.Items(i).Move dest
        End If
    Next

End Sub

Answer 2

“会话”必须是单数，不能是复数：

For Each oAccount In oOutlook.Session.Accounts