Outlook to Excel

[Kartyk]

HI All,

I have a file that extracts emails from outlook mailbox and also tracks the reponse/forward actions. It works seamlessly for individual mailbox.
Whereas, for the group mailbox,where multiple users are involved, I do not get the response for those emails.

Attaching the code for reference.

Option Explicit
Public ns As Outlook.Namespace
Private Const EXCHIVERB_REPLYTOSENDER = 102
Private Const EXCHIVERB_REPLYTOALL = 103
Private Const EXCHIVERB_FORWARD = 104
Private Const PR_LAST_VERB_EXECUTED = "http://schemas.microsoft.com/mapi/proptag/0x10810003"
Private Const PR_LAST_VERB_EXECUTION_TIME = "http://schemas.microsoft.com/mapi/proptag/0x10820040"
Private Const PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
Private Const PR_RECEIVED_BY_ENTRYID As String = "http://schemas.microsoft.com/mapi/proptag/0x003F0102"

Private Function GetReply(olMailItem As MailItem) As MailItem
On Error Resume Next
Dim conItem As Outlook.Conversation
    Dim ConTable As Outlook.Table
    Dim ConArray() As Variant
    Dim MsgItem As MailItem
    Dim lp As Long
    Dim LastVerb As Long
    Dim VerbTime As Date
    Dim Clockdrift As Long
    Dim OriginatorID As String
Set conItem = olMailItem.GetConversation
    OriginatorID = olMailItem.PropertyAccessor.BinaryToString(olMailItem.PropertyAccessor.GetProperty(PR_RECEIVED_BY_ENTRYID))
If Not conItem Is Nothing Then
        Set ConTable = conItem.GetTable
        ConArray = ConTable.GetArray(ConTable.GetRowCount)
        LastVerb = olMailItem.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTED)
        Select Case LastVerb
            Case EXCHIVERB_REPLYTOSENDER, EXCHIVERB_REPLYTOALL, EXCHIVERB_FORWARD
                VerbTime = olMailItem.PropertyAccessor.GetProperty(PR_LAST_VERB_EXECUTION_TIME)
                VerbTime = olMailItem.PropertyAccessor.UTCToLocalTime(VerbTime)
                 Debug.Print "Reply to " & olMailItem.Subject & " sent on (local time): " & VerbTime
                For lp = 0 To UBound(ConArray)
                    If ConArray(lp, 4) = "IPM.Note" Then
                        Set MsgItem = ns.GetItemFromID(ConArray(lp, 0))
                        If Not MsgItem.Sender Is Nothing Then
                            If OriginatorID = MsgItem.Sender.ID Then
                                Clockdrift = DateDiff("s", VerbTime, MsgItem.SentOn)
                                If Clockdrift >= 0 And Clockdrift < 300 Then
                                    Set GetReply = MsgItem
                                    Exit For
                                End If
                            End If
                        End If
                    End If
                Next
            Case Else
        End Select
    End If
End Function

Public Sub ListIt()
    Dim myOlApp As New Outlook.Application
    Dim myItem As Object
    Dim myReplyItem As Outlook.MailItem
    Dim myFolder As Folder
    Dim xlRow As Long
    Dim olSharename As Outlook.Recipient
Set ns = myOlApp.GetNamespace("MAPI")
    'Set myFolder = ns.GetDefaultFolder(olFolderInbox)
    Set olSharename = ns.CreateRecipient("")
    Set myFolder = ns.GetSharedDefaultFolder(olSharename, olFolderInbox).Folders("")
End With
xlRow = 3
    For Each myItem In myFolder.Items
            If myItem.Class = olMail Then
            Set myReplyItem = GetReply(myItem)
            If Not myReplyItem Is Nothing Then
                PopulateSheet ActiveSheet, myItem, myReplyItem, xlRow
            xlRow = xlRow + 1
Else: PopulateSheet ActiveSheet, myItem, myReplyItem, xlRow
            xlRow = xlRow + 1
      End If
      End If
      ''End If
      DoEvents
    Next
MsgBox "Done"
End Sub

Private Sub PopulateSheet(mySheet As Worksheet, myItem As MailItem, myReplyItem As MailItem, xlRow As Long)
On Error Resume Next
Dim recips() As String
    Dim Recipients As Outlook.Recipient
    Dim lp As Long
With mySheet
        .Cells(xlRow, 1).FormulaR1C1 = myItem.SenderName
        .Cells(xlRow, 2).FormulaR1C1 = myItem.Subject
        .Cells(xlRow, 3).FormulaR1C1 = myItem.ReceivedTime
        .Cells(xlRow, 4).FormulaR1C1 = myItem.Categories
        .Cells(xlRow, 5).FormulaR1C1 = myReplyItem.SenderName
        For lp = 0 To myReplyItem.Recipients.Count - 1
            ReDim Preserve recips(lp) As String
            recips(lp) = myReplyItem.Recipients(lp + 1).Address
    Next
        .Cells(xlRow, 6).FormulaR1C1 = myReplyItem.To
        .Cells(xlRow, 7).FormulaR1C1 = myReplyItem.CC
        .Cells(xlRow, 8).FormulaR1C1 = myReplyItem.Subject
        .Cells(xlRow, 9).FormulaR1C1 = myReplyItem.SentOn
If .Cells(xlRow, 5).Value = "" Then
.Cells(xlRow, 11).FormulaR1C1 = "=Now()-RC[-8]"
    .Cells(xlRow, 11).NumberFormat = "[h]:mm:ss"
Else
.Cells(xlRow, 10).FormulaR1C1 = "=RC[-1]-RC[-7]"
        .Cells(xlRow, 10).NumberFormat = "[h]:mm:ss"
End If
    End With
End Sub

[Kartyk]

Any luck ?

[mancubus]

post your code as explained in my signature.

i dont know the answer.

but all the code you have posted is discussed for another requirement here:
https://forums.slipstick.com/threads...hared-mailbox/

maybe it will give you an idea.

good luck.

[Kartyk]

Ya, it was my post that was discussed there. I did not get the resolution and hence trying with different sources.

Thanks anyway for trying.


K

[Charlize]

Is there some kind of logging going on for which user does what on the shared mailbox.
Maybe if certain user answers a mail, the response would be sent to the user who did the action and not to the shared mailbox.
If you could find the actions that were done for certain mailitem in shared mailbox, you could search for the follow up in that users mailbox ?

Just a crazy idea off course ...

Charlize

[Kartyk]

Exactly !! reponses go from user's mail ID and not shared. Challenge comes from there. How do we follow-up on dynamic set of users having access to shared mailbox ?

Would you know the code to search the reponses from individual mailboxes for an item receieved on shared mailbox ?

Cheers
K

[Charlize]

What if the users from the shared mailbox use the address of the shared mailbox when sending out mails instead of their normal one ?

[Kartyk]

well, i tried but unsuccessful. Users select group mailbox as the sender but email still shows up on their sent items. When I read about it online, it is how it is intended to work. Only way is to find a code that looks sent items of all members and return the response.