Retrieve email's replier name of email in a shared mailbox

Question

I retrieve information for each email such as date received, date sent, sender and so on. This data is transferred into an Excel table.

I am looking into adding replier's email address, if the inbox email has been replied to.

By repliers I mean the users that have access to the common mailbox and reply to the emails received. Since our mailbox is shared, sometimes repliers are replying on behalf of [email protected], sometimes are replying as themselves.

I am not able to find any MAPI or MailItem propertes to retrieve the email's replier's name for inbox emails.

Sub ReportResponses()
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.Folder
    Dim objTable As Outlook.Table
    Dim objRow As Outlook.Row
    Dim objEX As Object
    Dim objWB As Object
    Dim objWS As Object
    Dim intR As Integer
    Dim val()
    Const PR_LAST_VERB_EXECUTION_TIME = "http://schemas.microsoft.com/mapi/proptag/0x10820040"
    Const PR_LAST_VERB_EXECUTED = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
    On Error Resume Next
        
    Set objNS = Application.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder
    Set objTable = objFolder.GetTable
        
    With objTable
        .Columns.RemoveAll
        .Columns.Add "SenderName"
        .Columns.Add "Subject"
        .Columns.Add "SentOn"
        .Columns.Add "UnRead"
        .Columns.Add PR_LAST_VERB_EXECUTION_TIME 'returns reply date
    End With
    If objTable.GetRowCount > 0 Then
        Set objEX = CreateObject("Excel.Application")
        Set objWB = objEX.Workbooks.Add
        Set objWS = objWB.Worksheets(1)
        intR = 4
        Do Until objTable.EndOfTable
            Set objRow = objTable.GetNextRow
            val = objRow.GetValues
            With objWS
                .Cells(intR, 1).Value = val(0)
                .Cells(intR, 2).Value = val(1)
                .Cells(intR, 3).Value = val(2)
                .Cells(intR, 4).Value = didReadMail(val(3))
                .Cells(intR, 5).Value = val(4)
                If IsDate(val(4)) Then
                    .Cells(intR, 6).Value = Hour(TimeDiff((CDate(val(4))), (CDate(val(2)))))
                End If
            End With
            intR = intR + 1
        Loop
        With objWS
            .Columns("A:G").EntireColumn.AutoFit
            .Cells(1, 1).Value = "Report on Messages in Folder: " & objFolder.FolderPath
            .Cells(3, 1).Value = "From"
            .Cells(3, 2).Value = "Subject"
            .Cells(3, 3).Value = "Received On"
            .Cells(3, 4).Value = "DidRead"
            .Cells(3, 5).Value = "Replied On"
            .Cells(3, 6).Value = "Resonse time in h"
            .Range("A1:G3").Font.Bold = True
            .Columns("D").EntireColumn.AutoFit
            .Range("A4").AutoFilter
        End With
        objEX.Visible = True
        objWB.Activate
    End If
    Set objTable = Nothing
    Set objRow = Nothing
    Set objEX = Nothing
    Set objWS = Nothing
End Sub
    
Function TimeDiff(ByRef StartTime As Date, ByRef StopTime As Date) As Date
    TimeDiff = CDate((StopTime - StartTime))
End Function
    
Function didReadMail(ByVal isUnread As Boolean) As Boolean
    If isUnread = False Then
        didReadMail = True
    Else
        didReadMail = False
    End If
End Function

Dmitry Streblechenko Dmitry Streblechenko · Accepted Answer · 2018-01-17T16:53:15

Try MailItem.ReceivedByName property.

If you want the name of the last user who modified the message (if a user replied to a message, the message will be modified), use the PR_LAST_MODIFIER_NAME property DASL name (http://schemas.microsoft.com/mapi/proptag/0x3FFA001F). You can also try to retrieve PR_LAST_MODIFIER_ENTRYID (DASL name http://schemas.microsoft.com/mapi/proptag/0x3FFB0102), convert it to hex, and open it as AddressEntry object using Namespace.GetAddressEntryFromID.

Retrieve email's replier name of email in a shared mailbox

1 Answers