为共享邮箱返回已归档邮件的单个发件人

Question

我编写了一个宏，该宏从Outlook中特定邮箱的“已发送邮件”中提取电子邮件。我正在使用.SenderName属性在Excel中填充发件人姓名。该邮箱由团队共享，并标记为“ ResearchHub”。

最近几天我拉出邮件时，宏正在工作。

[当我尝试绘制存档的邮件时，.SenderName属性将发件人拉出为'ResearchHub'，而不是发邮件的人。

[MailItem.SentOnBehalfOfName属性正在将研究中心作为发送者，而不是单个名称。

我尝试通过打开电子邮件并将它们复制到另一个文件夹中来取消存档，但是未能成功将特定用户作为发件人名称来获取。

Option Explicit
Sub test()

Dim Result As Object
Dim i As Integer
Dim dstart As Date
Dim dend As Date
Dim lower As String
Dim upper As String
Dim limit As String

dstart = InputBox("Enter Start Date in dd/mmm/yyyy format")
dend = InputBox("Enter End Date in dd/mmm/yyyy format")
lower = "[ReceivedTime] > '" & Format(dstart, "ddddd") & " 12:00 AM" & "'"
upper = "[ReceivedTime] > '" & Format(dend, "ddddd") & " 12:00 AM" & "'"

limit = lower & " AND " & upper

Dim objoutlook As outlook.Application
Dim oStore As outlook.Store
Dim onjNSpace As outlook.Namespace
Dim objFolder As outlook.Folder
Dim oAccount As Account

Set objoutlook = CreateObject("Outlook.Application")
Set objNSpace = objoutlook.GetNamespace("MAPI")

For Each objFolder In objNSpace.Folders

    If objFolder.Name = "Research Hub" Then

        Dim myfolder As outlook.Folder
        Set myfolder = objFolder.Folders("Sent Items")

        Dim objitem As Object
        Dim irow As Integer
        irow = 2
        Set Result = myfolder.Items.Restrict(limit)

        If Result.Couunt > 0 Then

            For i = 1 To Result.Count

                Cells(irow, 1) = objitem.SenderName
                Cells(irow, 2) = objitem.To
                Cells(irow, 3) = objitem.Subject

                irow = irow + 1

            Next i
        End If
    End If
Next

Set objoutlook = Nothing
Set objNSpace = Nothing
Set myfolder = Nothing

End Sub

Answer 1

改为使用MailItem.SentOnBehalfOfName属性。