none
MS Outlook data to be captured automatically to Excel

    Question

  • Hi,

    First of all i would like to state here is that i am a non-technical person, i.e. from the Medical background.

    But, i handle the work of mail management in my organization and hence in a day, i get about 200-300 mails to which i need to respond.

    Here, all i would like to ask is that, is there any possible way that i could keep a track of all the mails i receive and send to a particular person in MS Excel??

    All i would like to be capture automatically is the following things :

    1) Mail from

    2) Mail received time and date

    3) Mail subject line

    4) Mail replied to

    5) Mail response

    6) Mail response time and date which i do

    If anyone could help me guide how this could be done, it will be saving a lot of my time which i spend generally typing manually. Your help would be really appreciated a lot.

    I heard from one of my friend that this is possible if a macro could be created for this.

    Can someone help me here???

    Tuesday, July 23, 2013 4:29 PM

Answers

  • This will need more than one macro if you plan to record incoming and outgoing messages.

    Start by creating a workbook with two sheets. Call the first sheet 'Received' and the second sheet 'Sent'. Put a heading row on the Received sheet with four columns titled Date, Time, From and Subject

    Do the same on the other sheet with the column titles Date, Time, To and Subject.

    Save and close the workbook and note the location.

    In the Outlook VBA project ThisSession module copy the following. Change the path in bold to reflect the name and location of the workbook you have created.

    Option Explicit
    Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)
    Dim myItem As MailItem
    Dim strValues As String
    Dim strTo As String
    Dim strDate As String
    Dim strTime As String
    Dim strSubject As String
    Const strWorkbook As String = "C:\Path\MessageLog.xlsx"
    Const strSheet As String = "Sent"

        Set myItem = olItem
        strTo = myItem.To
        strDate = Format(Date, "mm.dd.yyyy")
        strTime = Format(Time, "HH:MM")
        strSubject = Replace(myItem.Subject, "'", "")
        strValues = strDate & "', '" & strTime & "', '" & strTo & "', '" & strSubject
        WriteToXLWorksheet strWorkbook, strSheet, strValues
    End Sub

    In a new module, copy and paste the following

    Option Explicit
    Public Function WriteToXLWorksheet(strWorkbook As String, _
                                       strRange As String, _
                                       strValues As String)
    Dim ConnectionString As String
    Dim strSQL As String
    Dim CN As Object
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strWorkbook & ";" & _
                           "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
        strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
        Set CN = CreateObject("ADODB.Connection")
        Call CN.Open(ConnectionString)
        Call CN.Execute(strSQL, , 1 Or 128)
        CN.Close
        Set CN = Nothing
    End Function

    Sub LogIncoming(olItem As Outlook.MailItem)
    Dim strValues As String
    Dim strFrom As String
    Dim strDate As String
    Dim strTime As String
    Dim strSubject As String
    Const strWorkbook As String = "C:\Path\MessageLog.xlsx"
    Const strSheet As String = "Received"
        strFrom = olItem.SenderEmailAddress
        strDate = Format(olItem.ReceivedTime, "mm.dd.yyyy")
        strTime = Format(olItem.ReceivedTime, "HH:MM")
        strSubject = Replace(olItem.Subject, "'", "")
        strValues = strDate & "', '" & strTime & "', '" & strFrom & "', '" & strSubject
        WriteToXLWorksheet strWorkbook, strSheet, strValues
    End Sub

    Create a rule to run the script LogIncoming for all the incoming messages that you wish to log.

    All outgoing messages are logged when you click send from the message with the current time and date.

    You can test that script by selecting a message in your inbox and run the following macro

    Sub Test()
    Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        LogIncoming olMsg
    End Sub

    I am not sure that it is practical to store the outgoing message bodies, at least not with this method.


    Graham Mayor - Word MVP
    www.gmayor.com

    Wednesday, July 24, 2013 8:46 AM

All replies

  • This will need more than one macro if you plan to record incoming and outgoing messages.

    Start by creating a workbook with two sheets. Call the first sheet 'Received' and the second sheet 'Sent'. Put a heading row on the Received sheet with four columns titled Date, Time, From and Subject

    Do the same on the other sheet with the column titles Date, Time, To and Subject.

    Save and close the workbook and note the location.

    In the Outlook VBA project ThisSession module copy the following. Change the path in bold to reflect the name and location of the workbook you have created.

    Option Explicit
    Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)
    Dim myItem As MailItem
    Dim strValues As String
    Dim strTo As String
    Dim strDate As String
    Dim strTime As String
    Dim strSubject As String
    Const strWorkbook As String = "C:\Path\MessageLog.xlsx"
    Const strSheet As String = "Sent"

        Set myItem = olItem
        strTo = myItem.To
        strDate = Format(Date, "mm.dd.yyyy")
        strTime = Format(Time, "HH:MM")
        strSubject = Replace(myItem.Subject, "'", "")
        strValues = strDate & "', '" & strTime & "', '" & strTo & "', '" & strSubject
        WriteToXLWorksheet strWorkbook, strSheet, strValues
    End Sub

    In a new module, copy and paste the following

    Option Explicit
    Public Function WriteToXLWorksheet(strWorkbook As String, _
                                       strRange As String, _
                                       strValues As String)
    Dim ConnectionString As String
    Dim strSQL As String
    Dim CN As Object
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strWorkbook & ";" & _
                           "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
        strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
        Set CN = CreateObject("ADODB.Connection")
        Call CN.Open(ConnectionString)
        Call CN.Execute(strSQL, , 1 Or 128)
        CN.Close
        Set CN = Nothing
    End Function

    Sub LogIncoming(olItem As Outlook.MailItem)
    Dim strValues As String
    Dim strFrom As String
    Dim strDate As String
    Dim strTime As String
    Dim strSubject As String
    Const strWorkbook As String = "C:\Path\MessageLog.xlsx"
    Const strSheet As String = "Received"
        strFrom = olItem.SenderEmailAddress
        strDate = Format(olItem.ReceivedTime, "mm.dd.yyyy")
        strTime = Format(olItem.ReceivedTime, "HH:MM")
        strSubject = Replace(olItem.Subject, "'", "")
        strValues = strDate & "', '" & strTime & "', '" & strFrom & "', '" & strSubject
        WriteToXLWorksheet strWorkbook, strSheet, strValues
    End Sub

    Create a rule to run the script LogIncoming for all the incoming messages that you wish to log.

    All outgoing messages are logged when you click send from the message with the current time and date.

    You can test that script by selecting a message in your inbox and run the following macro

    Sub Test()
    Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        LogIncoming olMsg
    End Sub

    I am not sure that it is practical to store the outgoing message bodies, at least not with this method.


    Graham Mayor - Word MVP
    www.gmayor.com

    Wednesday, July 24, 2013 8:46 AM
  • Hi,

    Thanks alot for your extended help and support.

    With the help of a bit googling, i was able to record the incoming messages time and details.

    But, is there any macro of sent mails also.????

    Thursday, July 25, 2013 5:44 PM
  • The macros I posted will record both sent and received e-mails?

    Graham Mayor - Word MVP
    www.gmayor.com

    Friday, July 26, 2013 1:01 PM
  • Hi, I am only able to get the message bodies and contents of only incoming mails. Outgoing ones are not getting captured with the above macro. Moreover, i would like to know what exactly you meant to say by the line, "create a rule to run the script..," I was unable to understand what you exactly meant by that. Can you please elaborate???
    Saturday, July 27, 2013 2:30 AM
  • It is the incoming mails that are handled by the Outlook rule. If you are able to monitor the incoming messages using the script LogIncoming, then it would seem that you already have setup the rule to do so.

    If that is not what you have done then create a new rule that works on all incoming messages and apply the script LogIncoming to that rule.

    Outgoing mails are handled by the first macro - Application_ItemSend which acts on all sent messages automatically. You do however have to setup the workbook as described (and change the path where indicated in bold to match that workbook) for it to do so.


    Graham Mayor - Word MVP
    www.gmayor.com

    Saturday, July 27, 2013 7:24 AM
  • Hi Graham,

    I am still unable to trace the outgoing mails by this.

    While incoming mails are traced by running the macro :  

    Sub Test()
    Dim olMsg As MailItem
        On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        LogIncoming olMsg
    End Sub "

    I am unable to record the outgoing mails automatically as you told, they will be handled automatically as i reply to them.

    Kindly help in that case.?

    Sunday, July 28, 2013 4:11 AM
  • If the macro

    Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)

    is in the ThisSession module of the VBA project, this macro runs automatically whenever you send a message. The test macro does not have any effect on this macro.


    Graham Mayor - Word MVP
    www.gmayor.com


    Sunday, July 28, 2013 5:32 AM
  • Hi graham,

    This is the issue i am facing, this macro is not functioning automatically, i.e., as i send a mail, it does not does anything in the excel.

    Kindly help me in that case.???

    Monday, July 29, 2013 4:10 PM
  • It should be easy enough to test whether the macro runs. Locate the line

    Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)

    and immediately below it add

    MsgBox "The Item Send macro is running!"

    When you send an e-mail you should see the message "The Item Send macro is running'

    If you see the message you haven't setup the workbook as instructed.

    If you don't see the message the macro is in the wrong module. It goes in the ThisOutlookSession module.


    Graham Mayor - Word MVP
    www.gmayor.com

    Tuesday, July 30, 2013 1:32 PM
  • Hi graham,

    This is not helping.

    It is not working out for me in the Sent sheet.

    And i confirm that the workbook's path also, i have defined in right way and also the workbook also has been designed in the same way as instructed.

    Kindly let me know in a more detailed and easy way if possible???

    Tuesday, July 30, 2013 5:23 PM
  • I regret I have no idea why it is not working for you. I take it that you see the message you added that indicates the macro is running, and that you have replaced "C:\Path\MessageLog.xlsx" with the correct name and path of your Workbook?

    Locate the line

    strValues = strDate & "', '" & strTime & "', '" & strTo & "', '" & strSubject

    and immediately below it add

    MsgBox strValues & vbcr & strWorkbook & vbcr & strSheet

    Send a message.

    What EXACTLY does the message box report?


    Graham Mayor - Word MVP
    www.gmayor.com

    Wednesday, July 31, 2013 5:43 AM
  • Hi Graham,

    Actually i don't see any message box.

    I have tried doing all of the above.

    Can u virtually somehow see how i have made things and then correct accordingly using Team Viewer.???

    If its possible for you???

    Monday, August 5, 2013 3:40 PM
  • Hi Graham,

    Kindly reply as and when you read this.

    Tuesday, August 6, 2013 4:18 PM
  • Hi... you need to copy and paste the coding to ThisOutlookSession and not in the moudle.. so that all the sent items will get caputred..
    Sunday, February 23, 2014 5:29 PM
  • Graham,

    That works like a dream. The only problem is that the message body is not getting captured. The only columns getting captured are : Date, time, from and Subject. Kindly post the code for getting the subject body as well.

    Cheers.

    Monday, October 23, 2017 4:42 AM
  • Hello,

    your macro is amazing,

    Only a little thing is not working for me , might be i did something wrong.

    in case of received items in outlook- subject line is not capturing properly

    example below-

    '/O=EXCHANGELABS/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN=625CB11EEB5F41D3B97CCBFAA50F95F6-SINGHAL, AB

    i am getting this in subject instead of Singhal,Abhishek

    Please help.

    and thanks again for the macro.

    Regards

    Abhishek


    Monday, August 20, 2018 9:26 AM
  • The code I posted was merely a guide - see also https://www.gmayor.com/extract_data_from_email.htm

    What EXACTLY is in the subject line of the message and what code have you used to extract that line? The string you have posted does not contain the text Singhal,Abhishek. It contains Singhal, AB which should be extractable from that string using the following which assumes strSubject is your string

    strSubject = Split(strSubject, "-")(1)


    Graham Mayor - Word MVP
    www.gmayor.com

    Tuesday, August 21, 2018 3:55 AM
  • Wao, its working..

    One more thing Graham,

    Can we extract data from multiple emails at one go??

    instead of going on one mail and run the macro everytime?




    • Edited by Abhi301190 Thursday, August 23, 2018 1:30 PM
    Thursday, August 23, 2018 1:30 PM
  • The macro was intended to be run from a rule to process the messages as they arrive. If you want to run it on a selected group of messages then you would need to loop through those messages and run it on each of them e.g.

    Sub ProcessSelection()
    Dim olExplorer As Outlook.Explorer
    Dim olSelection As Outlook.Selection
    Dim olItem As Outlook.MailItem
    
        On Error GoTo err_handler
        Set olExplorer = Application.ActiveExplorer
        Set olSelection = olExplorer.Selection
        If olSelection.Count = 0 Then
            MsgBox "Nothing selected"
            GoTo lbl_Exit
        End If
        For Each olItem In olSelection
            LogIncoming olItem 'run the macro'
            DoEvents
        Next olItem
    lbl_Exit:
        Set olExplorer = Nothing
        Set olSelection = Nothing
        Set olItem = Nothing
        Exit Sub
    err_handler:
        Beep
        Err.Clear
        GoTo lbl_Exit
    End Sub
    


    Graham Mayor - Word MVP
    www.gmayor.com

    Friday, August 24, 2018 3:55 AM
  • Graham,

    You are great man,, thanks a lot it helps a lot...

    Will ask questions again if anything comes up..

    thanks a lot again

    Warm Regards

    Abhishek

    Friday, August 24, 2018 6:46 AM
  • Hello Graham,

    1)for the above i replaced the 

    strSubject = Replace(olItem.Subject, "'", "")

    with 

    strSubject = Split(strSubject, "-")(1)

    but it is showing the Subscript out of range, can you please help.

    2) Also one more thing- how to run this macro automatically once the mail comes for a specific folder?

    Abhishek Singhal


    Friday, August 31, 2018 6:00 AM
  • Hello, Its 2019 and your macro is the one I need, but in the new outlook 2016 and 360 the option to run scripts based on a rule is no longer active and modifying a registry is not an option for me. Will it be possible for you to get us an updated macro to work with new office version?
    Tuesday, May 21, 2019 9:27 PM