VBA从Outlook上的共享邮箱导入电子邮件到Excel

时间:2018-11-19 02:40:29

标签: vba

您能帮我提供这个代码吗?我需要知道共享邮箱收到的电子邮件总数。我的代码运行流畅,但仅显示收件箱中未读电子邮件的数量。我希望它同时显示已读和未读。

请参见下面的代码:

Sub getDataFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim objOwner As Outlook.Recipient
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace =    OutlookApp.GetNamespace("MAPI")
Set objOwner =  OutlookNamespace.CreateRecipient("xxxxxx@xxxxxx.com")
objOwner.Resolve

If objOwner.Resolved Then
    Set Folder =     OutlookNamespace.GetSharedDefaultFolder(objOwner, olFolderInbox)
End If

i = 1

For Each OutlookMail In Folder.Items

    If OutlookMail.ReceivedTime >= Range("email_ReceiptDate").Value Then

        Range("email_Subject").Offset(i, 0) = OutlookMail.Subject
        Range("email_Subject").Offset(i, 0).Columns.AutoFit
        Range("email_Subject").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Date").Offset(i, 0) = OutlookMail.ReceivedTime
        Range("email_Date").Offset(i, 0).Columns.AutoFit
        Range("email_Date").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Sender").Offset(i, 0) = OutlookMail.SenderName
        Range("email_Sender").Offset(i, 0).Columns.AutoFit
        Range("email_Sender").Offset(i, 0).VerticalAlignment = xlTop
        Range("email_Body").Offset(i, 0) = OutlookMail.Body
        Range("email_Body").Offset(i, 0).Columns.AutoFit
        Range("email_Body").Offset(i, 0).VerticalAlignment = xlTop

        i = i + 1

    End If

 Next OutlookMail

 Set Folder = Nothing
 Set OutlookNamespace = Nothing
 Set OutlookApp = Nothing

End Sub

0 个答案:

没有答案