Vba импортировать электронную почту из общего почтового ящика в Outlook, чтобы преуспеть - PullRequest
Новая
       7

Vba импортировать электронную почту из общего почтового ящика в Outlook, чтобы преуспеть

0 голосов
/ 19 ноября 2018

Не могли бы вы помочь мне с этим кодом?Мне нужно знать общее количество писем, полученных общим почтовым ящиком.Мой код работает без сбоев, но показывает только количество непрочитанных писем во входящих.Я хочу, чтобы он показывал прочитанные и непрочитанные оба.

Пожалуйста, см. Ниже для кода: 

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
...