Creating a Simple Message Log in Outlook


This post goes out to David Hill who posted the following comment:

I currently have a outlook 2003 rule that looks for particular text in a subject title when I send a email out and copies the sent email to a specific folder.

In the perfect world I would like at the same time a macro to run automatically to save the required email data from the new sent email into an existing excel file (mail log), appended to the existing data?

Info required is = Subject / Date sent / To / CC

The solution to David’s issue is a script (macro) that’s called by a rule. All the script has to do is open the spreadsheet, find the next blank line, and write the four pieces of data David wants to it. Nothing complicated.

Requirements.

This code should work with any version of Outlook.

Instructions and Code.

  1. Start Outlook
  2. Press ALT+F11 to open the Visual Basic Editor
  3. If not already expanded, expand Microsoft Office Outlook Objects
  4. If not already expanded, expand Modules
  5. Select an existing module (e.g. Module1) by double-clicking on it or create a new module by right-clicking Modules and selecting Insert > Module.
  6. Copy the code from the code snippet box and paste it into the right-hand pane of Outlook’s VB Editor window
  7. Edit the code as needed. I placed comments where things can be changed.
  8. Click the diskette icon on the toolbar to save the changes
  9. Close the VB Editor
Sub LogMessage(Item As Outlook.MailItem)
    'On the next line edit the path to the Excel worksbook
    Const WKB_PATH = "C:\Users\David\Documents\TestArea\DavidHill.xlsx"
    'On the next line edit the name of the sheet to log to
    Const WKS_NAME = "Sheet1"
    Dim excApp As Object, excWkb As Object, excWks As Object, lngRow As Long
    Set excApp = CreateObject("Excel.Application")
    Set excWkb = excApp.Workbooks.Open(WKB_PATH)
    Set excWks = excWkb.Worksheets(WKS_NAME)
    lngRow = excWks.UsedRange.Rows.Count + 1
    'On the following four lines reorder the items as desired and change the column numbers
    excWks.Cells(lngRow, 1) = Item.Subject
    excWks.Cells(lngRow, 2) = Item.SentOn
    excWks.Cells(lngRow, 3) = Item.To
    excWks.Cells(lngRow, 4) = Item.CC
    Set excWks = Nothing
    excWkb.Close True
    Set excWkb = Nothing
    Set excApp = Nothing
End Sub

Modify the Rule.

Once the code is in place David will have to modify his rule. To do that he’ll

  1. Edit the rule.
  2. Add the “run a script” action
  3. Set this script as the one to run

Revisions.

  • Revision 1

David’s computer is locked down and apparently cannot run a script from a rule. He can however run macros (scripts) manually. This revision allows him to select a folder and run the script against all items in the folder.

Sub RunLogMessage()
    Dim olkItm as Object
    For Each olkItm in Application.ActiveExplorer.CurrentFolder.Items
        If olkItm.Class = olMail Then
            LogMessage olkItm
        End If
    Next
End Sub

Sub LogMessage(Item As Outlook.MailItem)
    'On the next line edit the path to the Excel worksbook
    Const WKB_PATH = "C:\Users\David\Documents\TestArea\DavidHill.xlsx"
    'On the next line edit the name of the sheet to log to
    Const WKS_NAME = "Sheet1"
    Dim excApp As Object, excWkb As Object, excWks As Object, lngRow As Long
    Set excApp = CreateObject("Excel.Application")
    Set excWkb = excApp.Workbooks.Open(WKB_PATH)
    Set excWks = excWkb.Worksheets(WKS_NAME)
    lngRow = excWks.UsedRange.Rows.Count + 1
    'On the following four lines reorder the items as desired and change the column numbers
    excWks.Cells(lngRow, 1) = Item.Subject
    excWks.Cells(lngRow, 2) = Item.SentOn
    excWks.Cells(lngRow, 3) = Item.To
    excWks.Cells(lngRow, 4) = Item.CC
    Set excWks = Nothing
    excWkb.Close True
    Set excWkb = Nothing
    Set excApp = Nothing
End Sub
Advertisements

2 comments on “Creating a Simple Message Log in Outlook

  1. Hi David

    I have changed the code slightly to give my own path and file name and the macro runs. The problem is it inputs to line 2 in the excel sheet for each email and does not increment down. Therefore I have only one line in the excel sheet that corresponds to the last email in the Outlook folder I have choose.

    My VB is very basic I can not see how the first macro counts how email in a folder and passes that to the second macro to write to the excel sheet?

    Sub Run_Log_Message()
    Dim olkItm As Object
    For Each olkItm In Application.ActiveExplorer.CurrentFolder.Items
    If olkItm.Class = olMail Then
    Log_Message olkItm
    End If
    Next
    End Sub
    
    Sub Log_Message(Item As Outlook.MailItem)
    'On the next line edit the path to the Excel worksbook
    Const WKB_PATH = "C:\Documents and Settings\hilld12\Temp\DavidHill.xls"
    'On the next line edit the name of the sheet to log to
    Const WKS_NAME = "Sheet1"
    Dim excApp As Object, excWkb As Object, excWks As Object, lngRow As Long
    Set excApp = CreateObject("Excel.Application")
    Set excWkb = excApp.Workbooks.Open(WKB_PATH)
    Set excWks = excWkb.Worksheets(WKS_NAME)
    lngRow = excWks.UsedRange.Rows.Count + 1
    'On the following four lines reorder the items as desired and change the column numbers
    excWks.Cells(lngRow, 1) = Item.Subject
    excWks.Cells(lngRow, 2) = Item.SentOn
    excWks.Cells(lngRow, 3) = Item.To
    excWks.Cells(lngRow, 4) = Item.CC
    Set excWks = Nothing
    excWkb.Close True
    Set excWkb = Nothing
    Set excApp = Nothing
    End Sub
    
    • Hi, David.

      It’s a quirk of how UsedRange.Rows.Count works. The simplest solution is to put column headers on row 1 of the spreadsheet. As an alternative I can modify the code to work for spreadsheets that don’t have headers.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s