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

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

For Each oAccount In oOutlook.Session.Accounts

Answer 2

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

在工作解决方案中，您找到一个名为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

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

2 个答案: