Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

Outlook macro that can compare the sent and received mails and display on an excel.

Hi,

Outlook macro that can compare the sent and received mails and display on an excel.
Very offen i send individual mails to employers on Virus or asset or configuration etc. I need to check on there responses.

Can i have a macro that first asks me for the sent mails folder then the received mails folder then puts all email i's in the colum A and colum B with received . Then in C show Yes or No after sorting them.

Regards
Sharath
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Not too sure about the viability here.

Is there some absolute method to evaluate a match ... a unique seial number or something?

In theory accessing all the files and recording them is OK.  It is defining which sent items match up to a received item that concerns me.

Chris
Avatar of bsharath

ASKER

Ok..

Sent item has to be checked in the "TO"
Received has to be checked in the "From" If both the email id's match that means i have received a reply.

As just for one particular issue i will have these sent and received folders in outlook with just that mails.
I will create a rule that moves mails on the type to these folder. So there is no chance of i have any other type of mail in there.
>>> If both the email id's match

Where is the ID stored and what does it look like.

Chris
I want to just match email id's
Say i send a mail to you. (In this case your email id)
You send a mail back to me (Your Mail id)
So when the script check both folders and gets the mail i sent to you and you sent to me then the result should be (Yes)
If not found then (No)
Ah sorry I was looking too deep, in my terms I presume you are referring to matching email addresses.

I'll work on it offline.  Not sure how easy / hard but I reckon it's viable.

Where do you want the macro to run from ... in theory excel is the easiest but whatever you want.

Chris
From any where until i get a selection to select the 2 folders i want to query..
bsharath,

Silly question but is there any point in column B ... all the ID's as sent will be in column A and column C will have received yes or no so column B would simply be the same email as column A where column C has a yes ... wouldn't it?

chris_bottomley
Yes if i can have the sent items and the colum B with Yes or No that would be fine.
What i thought was
Colum A the sent email id's and colum B the Received email id's and colum C will have Yes or No...

Any way is ok for me...
APologies for the delay.  I have been looking into methods of making the request for folders 'prompted'.  I can see there is a way but I need to invest some effort to do so.  This puts it outside of this Q and into my todo pile.

I will proceed here now with two successive folder requests, (sent followed by received) hopefully upload something later).

Chris
Ok thanks
See the attached snippet and sample file

Chris
Option Explicit
Const olmail = 43
 
Sub getmails()
Dim sh As Worksheet
Dim olApp As Object
Dim olNS As Object
Dim olSent As Object
Dim olRx As Object
Dim mai As Object
Dim maiToDict As Object
Dim maiFromDict As Object
'Dim mailCOunt As Integer
Dim dictkEY As Variant
Dim rw As Long
 
    Set sh = ThisWorkbook.Worksheets(1)
    Set maiToDict = CreateObject("scripting.dictionary")
    Set maiFromDict = CreateObject("scripting.dictionary")
    Set olApp = CreateObject("outlook.application")
    Set olNS = olApp.getnamespace("MAPI")
    Set olSent = olNS.pickfolder
    Set olRx = olNS.pickfolder
    For Each mai In olSent.items
        On Error GoTo assume_encrypted_to
        If mai.class = olmail Then
            If Not maiToDict.exists(LCase(mai.Recipients(1).Address)) Then maiToDict.Add LCase(mai.Recipients(1).Address), LCase(mai.Recipients(1).Address)
        End If
assume_encrypted_to:
    Next
    For Each mai In olRx.items
        On Error GoTo assume_encrypted_rx
        If mai.class = olmail Then
            If Not maiFromDict.exists(LCase(mai.Recipients(1).Address)) Then maiFromDict.Add LCase(mai.Recipients(1).Address), LCase(mai.Recipients(1).Address)
        End If
assume_encrypted_rx:
    Next
' Populate the sheet
 
    sh.Cells.Delete
    sh.Range("A1") = "Email TO:"
    sh.Range("B1") = "Email FROM:"
    sh.Range("C1") = "Received email - Yes/No"
'    dictKeys = maiToDict.keys
    rw = 2
    For Each dictkEY In maiToDict.Keys
        sh.Range("A" & rw) = maiToDict.Item(dictkEY)
        If maiFromDict.exists(maiToDict.Item(dictkEY)) Then
            sh.Range("B" & rw) = maiToDict.Item(dictkEY)
            sh.Range("C" & rw) = "Yes"
        Else
            sh.Range("C" & rw) = "No"
        End If
        rw = rw + 1
    Next
    sh.Range("A:C").Columns.AutoFit
    sh.Range("C:C").HorizontalAlignment = xlCenter
End Sub

Open in new window

checkMailInOut.xls
Thanks Chris. Its definately the right way and its working but...
Not total.

I have 300 Sent mails which i selected with the received folder which has 2500 mails i just got 15 as YES and they are correct.

But there are many more which has the mail in both places but shows "NO"
Thanks Chris. Its definately the right way and its working but...
Not total.

I have 300 Sent mails which i selected with the received folder which has 2500 mails i just got 15 as YES and they are correct.

But there are many more which has the mail in both places but shows "NO"
I assumed a single recipient in each case ... is it the casethat there are multiple recipients?

Chris
Sub modified to assume multiple recipients anyway and see if it affects the result

Chris
Sub getmails()
Dim sh As Worksheet
Dim olApp As Object
Dim olNS As Object
Dim olSent As Object
Dim olRx As Object
Dim mai As Object
Dim maiToDict As Object
Dim maiFromDict As Object
'Dim mailCOunt As Integer
Dim dictkEY As Variant
Dim rw As Long
Dim recipCount As Integer
 
    Set sh = ThisWorkbook.Worksheets(1)
    Set maiToDict = CreateObject("scripting.dictionary")
    Set maiFromDict = CreateObject("scripting.dictionary")
    Set olApp = CreateObject("outlook.application")
    Set olNS = olApp.getnamespace("MAPI")
    Set olSent = olNS.pickfolder
    Set olRx = olNS.pickfolder
    For Each mai In olSent.items
        On Error GoTo assume_encrypted_to
        If mai.class = olmail Then
            For recipCount = 1 To mai.Recipients.Count
                If Not maiToDict.exists(LCase(mai.Recipients(recipCount).Address)) Then maiToDict.Add LCase(mai.Recipients(recipCount).Address), LCase(mai.Recipients(recipCount).Address)
            Next
        End If
assume_encrypted_to:
    Next
    For Each mai In olRx.items
        On Error GoTo assume_encrypted_rx
        If mai.class = olmail Then
            For recipCount = 1 To mai.Recipients.Count
                If Not maiFromDict.exists(LCase(mai.Recipients(recipCount).Address)) Then maiFromDict.Add LCase(mai.Recipients(recipCount).Address), LCase(mai.Recipients(recipCount).Address)
            Next
        End If
assume_encrypted_rx:
    Next
' Populate the sheet
 
    sh.Cells.Delete
    sh.Range("A1") = "Email TO:"
    sh.Range("B1") = "Email FROM:"
    sh.Range("C1") = "Received email - Yes/No"
'    dictKeys = maiToDict.keys
    rw = 2
    For Each dictkEY In maiToDict.Keys
        sh.Range("A" & rw) = maiToDict.Item(dictkEY)
        If maiFromDict.exists(maiToDict.Item(dictkEY)) Then
            sh.Range("B" & rw) = maiToDict.Item(dictkEY)
            sh.Range("C" & rw) = "Yes"
        Else
            sh.Range("C" & rw) = "No"
        End If
        rw = rw + 1
    Next
    sh.Range("A:C").Columns.AutoFit
    sh.Range("C:C").HorizontalAlignment = xlCenter
End Sub

Open in new window

Yes i will have more than i received or even sent mail in the folders from or to the same person..

Now when i tryed the script nothing comes into the excel just the headers are displayed...
Yes i will have more than i received or even sent mail in the folders from or to the same person..

Now when i tryed the script nothing comes into the excel just the headers are displayed...
YOu did keep the definition in th emodule didn't you?

Const olmail = 43
 
Chris
Sorry missed that but still get only 10% of them to the excel.

The Sent populates correctly only the received does not get all id's to colum B
Sorry missed that but still get only 10% of them to the excel.

The Sent populates correctly only the received does not get all id's to colum B
Can I draw your attention back to an earlier questionfor which I missed any response so went ahead with my own assumption:

"Silly question but is there any point in column B ... all the ID's as sent will be in column A and column C will have received yes or no so column B would simply be the same email as column A where column C has a yes ... wouldn't it?"

Hence in this release I only populate columns B&C if I see a matching email.

Chris
If i can get just the sent user names in Colum A and Yes or No in Colum B then also i am ok. But i thought if you were to get the Sent in "A" and Received in "B" and use some excel macro to sort them accordingly and get "Yes" or "No" in "C"

I think i got you confused...

I just need the sent names and yes or no comparing the received folder.


If i can get just the sent user names in Colum A and Yes or No in Colum B then also i am ok. But i thought if you were to get the Sent in "A" and Received in "B" and use some excel macro to sort them accordingly and get "Yes" or "No" in "C"

I think i got you confused...

I just need the sent names and yes or no comparing the received folder.


I think I see the error ... bear with me

Chris
Try this!  COmplete code module

Chris
Const olmail = 43
 
Sub getmails()
Dim sh As Worksheet
Dim olApp As Object
Dim olNS As Object
Dim olSent As Object
Dim olRx As Object
Dim mai As Object
Dim maiToDict As Object
Dim maiFromDict As Object
'Dim mailCOunt As Integer
Dim dictkEY As Variant
Dim rw As Long
Dim recipCount As Integer
 
    Set sh = ThisWorkbook.Worksheets(1)
    Set maiToDict = CreateObject("scripting.dictionary")
    Set maiFromDict = CreateObject("scripting.dictionary")
    Set olApp = CreateObject("outlook.application")
    Set olNS = olApp.getnamespace("MAPI")
    Set olSent = olNS.pickfolder
    Set olRx = olNS.pickfolder
    For Each mai In olSent.items
        On Error GoTo assume_encrypted_to
        If mai.class = olmail Then
            For recipCount = 1 To mai.Recipients.Count
                If Not maiToDict.exists(LCase(mai.Recipients(recipCount).Address)) Then maiToDict.Add LCase(mai.Recipients(recipCount).Address), LCase(mai.Recipients(recipCount).Address)
            Next
        End If
assume_encrypted_to:
    Next
    For Each mai In olRx.items
        On Error GoTo assume_encrypted_rx
        If mai.class = olmail Then
            If Not maiFromDict.exists(LCase(mai.SenderEmailAddress)) Then maiFromDict.Add LCase(mai.SenderEmailAddress), LCase(mai.SenderEmailAddress)
        End If
assume_encrypted_rx:
    Next
' Populate the sheet
 
    sh.Cells.Delete
    sh.Range("A1") = "Email TO:"
    sh.Range("B1") = "Email FROM:"
    sh.Range("C1") = "Received email - Yes/No"
'    dictKeys = maiToDict.keys
    rw = 2
    For Each dictkEY In maiToDict.Keys
        sh.Range("A" & rw) = maiToDict.Item(dictkEY)
        If maiFromDict.exists(maiToDict.Item(dictkEY)) Then
            sh.Range("B" & rw) = maiToDict.Item(dictkEY)
            sh.Range("C" & rw) = "Yes"
        Else
            sh.Range("C" & rw) = "No"
        End If
        rw = rw + 1
    Next
    sh.Range("A:C").Columns.AutoFit
    sh.Range("C:C").HorizontalAlignment = xlCenter
End Sub

Open in new window

99% perfect now...
Out of 300 mails i get 150 as No. Now when i check some of thos 150 they are available in both folders...
Is there some specific reason?

Both the folders there are 2 mails each from and to the same person
99% perfect now...
Out of 300 mails i get 150 as No. Now when i check some of thos 150 they are available in both folders...
Is there some specific reason?

Both the folders there are 2 mails each from and to the same person
Chris i just found that some names which have spaces are changed to without space.

The name which has to be as
Sharath goneis as
Sharathgone

May be because if that. Just a thought
Chris i just found that some names which have spaces are changed to without space.

The name which has to be as
Sharath goneis as
Sharathgone

May be because if that. Just a thought
ASKER CERTIFIED SOLUTION
Avatar of Chris Bottomley
Chris Bottomley
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Chris now the colum C is not being populated.
I can see that all the the sent are there and received also where some received are blank in colum B
When i search the blank data that the received was not populated i can still find them...
There is no processing on this data .. it simply a list of addresses you sent emails to and a list of people who you received emails from ... columns A and B respectively.

The problem you identified is that some responders are being missed.  I need to know why and this is where you need to find the sender for one of these missing responses in the original data as in column B of this version and let me know how the address in column B here for that person differs from that in column A of this release.

Armed with that information I can hopefiully modify the source to correctly match the responders to the sent emails.

i.e. I need a sample of sent email address from column and the received address for that person in column B for one of the mails missing from the previous yes/no population.

Chris
Ok got it...
For the ones which work perfect look as this
Sent
/o=group/ou=first administrative group/cn=recipients/cn=swpanp
Received
/o=group/ou=first administrative group/cn=recipients/cn=swpanp

The one which has a sent mail like this
/o=group/ou=first administrative group/cn=recipients/cn=suprnadas

Does not have a match
When i search in the received it does not fetch only when i change it to this i get
Suprna Das

One more example
This is in the sent results
/o=group/ou=first administrative group/cn=recipients/cn=arunkumarrman

When i search i dont get a result when i search as this i get results
arun kumar rman

I just realized that its a great mistake from my end that i did not tell you we even have contact..

All that are not found are contact that we have.

All users with mailbox are retrieved perfect just the users to whome i have mailed to a contact dont get them right

Sorry for that. See if this can be resolved or else no problem... As that are few 100's which i can check manually...
In all honesty it will require a few tests by you with subs to be defined ... in order to confirm responses to AD interrogations.  I sugget fairest to me is a new question to close the gap, it wasn't one of the hardest applications but I think value for money all the same.  I may not be the one that picks up on a new question of course but I think doable therefore you need not plan doing it manually.

Chris