Question

处理一些从outlook 2013下载数据的小项目，但我被困在一个地方，我可以更改Outlook帐户，然后下载他们的收件箱/发送邮件/等。

有问题的地方是哪些****在哪里被确定文件夹，电子邮件（语法错误） - 我需要帮助。

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

多个帐户 - 多个收件箱文件夹 - 在代码和下载中指定电子邮件

Answer 1

不是使用brew，而是遍历Namespace.GetDefaultFolder集合（Outlook 2010及更高版本），找到您需要处理的商店，使用Namespace.Stores。

VBA选择下载电子邮件的帐户

1 个答案: