VBA hangi e-postaları karşıdan yükleyeceğiniz hesabı seçin

2013 yılına ait verileri indiren küçük bir proje üzerinde çalışıyordum, ancak outlook hesabını değiştirebileceğim bir yere sıkışıp kaldım ve sonra gelen kutularını/gönderilmiş postaları/etc.VBA hangi e-postaları karşıdan yükleyeceğiniz hesabı seçin

Sorunlu bir yer, nerede olduğu belirlenir klasörün nerede olduğu ve e-posta (sözdizimi yanlış) - yardıma ihtiyacım var.

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

Çoklu hesaplar - Birden gelen kutusu klasörleri - kodunda e belirtmek ve yerine Namespace.GetDefaultFolder, Namespace.Stores koleksiyonu (yukarı Outlook 2010 ve) üzerinden döngüsü kullanmak