Switching Email Accounts When Manipulating Emails

58 Views Asked by At

So I have multiple inboxes that I need to manipulate mail from. I am trying to loop through them and find the necessary mailbox, and folder, to move mails out of. When I get to "For Each oAccount in Outlook..." it tells me "object required". I'm having understanding how to make it loop through the accounts. I would be so so appreciative if anyone can show me where I'm making the error in the code below.

Thanks!

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

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

Okay, so I've solved it. Instead of trying to cycle through accounts, I cycled through folders in different namespaces. I am able to cycle through to the correct account and folder with the code below. Thanks!

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
2

There are 2 best solutions below

10
Dmitry Streblechenko On

"Session" must singular, not plural:

For Each oAccount In oOutlook.Session.Accounts
2
niton On

As you indicated in a comment, you have one account, so you cannot change accounts.

In your working solution you find a folder named Email@abc that is one email address in your account.

Whether the Br folder is in the default inbox or not, you may reference the folder directly, the long way, without using .GetDefaultFolder.

Instead of cycling through folders:

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