PDA

View Full Version : Outlook to Excel



Kartyk
10-26-2016, 05:53 AM
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.GetP roperty(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
10-27-2016, 05:26 AM
Any luck ?

mancubus
10-28-2016, 02:55 AM
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/94518-vba-to-measure-response-time-for-each-emails-in-a-shared-mailbox/

maybe it will give you an idea.

good luck.

Kartyk
11-02-2016, 12:43 AM
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
11-02-2016, 08:35 AM
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
11-03-2016, 03:21 AM
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
11-05-2016, 03:44 AM
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
11-09-2016, 06:54 AM
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.