VBA select account from which download emails

Question

Working on some small project, which download data from outlook 2013, but I'm stuck to one place, where I can change outlook account, and then download their inbox/sent mail/etc.

Problematic place is where are those **** where are determened folder, and email(syntax there is wrong) - there I need help.

Sub export_mail_from_outlook()

Dim objItm As Object
Dim objFolder As Folder
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim objParent As Folder
Dim lRow As Long
Dim epasts As String, mape As String

    epasts = ThisWorkbook.Sheets("Main desk").Cells(5, 2)
    mape = ThisWorkbook.Sheets("Main desk").Cells(6, 2)

'Izveidojam jaunu failu un sheetu, kur liksim vajadzigo informaciju
    Set xlApp = New Excel.Application
    Set xlWb = xlApp.Workbooks.Add
    Set xlSht = xlWb.Sheets(1)
'nosaucam faila ieklauto sheetu/izklajlapu
    xlSht.Name = "Inbox Mail Data"
'konkretaja sheet/izklajlapa definejam pirmas rindas/kolonnu nosaukumus(bez si var ari iztikt, tikai tad ir jamaian lRow vertiba)
    With xlSht
        .Cells(1, 1) = "Mape"
        .Cells(1, 2) = "Tēma"
        .Cells(1, 3) = "E-pasta saņemšanas datums"
        .Cells(1, 4) = "Teksts"
        .Cells(1, 5) = "Sūtītājs"
        .Cells(1, 6) = "Izmantotais epasts"
    End With

'mapes dzilumu mainit saja vieta, var nemt visu, kas ir tikai Inbox mape,
'var nemt visus, kas ir mapes apaksmape,
'un var nemt mapes un apaksmapes epastus
    ****Set objOutlook = CreateObject("Outlook.Application")
    ****Set objNameSpace = objOutlook.GetNamespace("MAPI")
    ****Set objParent = objNameSpace.GetDefaultFolder(olFolderInbox)


'no kuras rindas saks ladet datus
    lRow = 2

'datuma ierobezojums ierakstiem, visus ierakstus pec konkreta datuma, likt pec vajadzibas(var ari izveidot msgbox un ielasit vertibu, tad sintake bus sekojosa(pielabot)

    StrDate = InputBox("No kura datuma ielasīt e-pastus. Datuma forma: yyyy.mm.dd ?")
    If IsDate(StrDate) Then
    LimDate = DateValue(StrDate)
    Else: MsgBox "Nav pareizs datuma formāts, mēgini vēlreiz"
    Exit Sub
    End If

    'LimDate = VBA.DateValue(DateSerial(2016, 3, 1))

        On Error Resume Next
        With xlSht
            For Each objItm In objParent.Items
            If objItm.ReceivedTime >= LimDate Then
                .Cells(lRow, 1) = objParent
                .Cells(lRow, 2) = objItm.Subject
                .Cells(lRow, 3) = objItm.ReceivedTime
                .Cells(lRow, 4) = objItm.Body
                .Cells(lRow, 4).WrapText = False
                .Cells(lRow, 5) = objItm.Sender
                .Cells(lRow, 6) = epasts

                lRow = lRow + 1
            End If
            Next
        End With
        On Error GoTo 0


'izveidoto failu padarit redzamu
xlApp.Visible = True


Set xlSht = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

MsgBox "No " & LimDate & " visi mapes " & objParent & " epasta ieraksti no epasta " & epasts

End Sub

Multiple accounts - multiple inbox folders - specify email in code and download

Answer 1

Instead of using Namespace.GetDefaultFolder, loop through the Namespace.Stores collection (Outlook 2010 and up), find the store you need to process, use Store.GetDefaultFolder.