VBAのアカウントを選択してください

Question

Outlook 2010からデータをダウンロードする小さなプロジェクトで作業していますが、Outlookアカウントを変更してから受信トレイ/送信メールをダウンロードできる場所が1つあります。

問題のある場所はどこにありますか？****どこにあるのか、電子メール（構文が間違っている）があります。そこには助けが必要です。

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 

複数のアカウント - 複数の受信トレイフォルダ - コードで電子メールを指定し、代わりにNamespace.GetDefaultFolderを使用しての

Answer 1

をダウンロードし、Namespace.Storesコレクション（Outlook 2010の最大）をループ、あなたが処理する必要がある店を見つけます、Store.GetDefaultFolderを使用してください。