How to call MailItem.Display method when clicking on a table cell? - excel

Question

I need to call the Outlook MailItem.Display method when clicking on a specific cell in a table column in Excel.
Below is my module for filling out table.
' This module performs email retrieval and viewing. Dynamically adds email information to a table and creates
' links that open Outlook mailitems in a modal window.
Option Explicit
'Initialize Outlook objects
Dim appOL, appNS, appFolder, email As Object
'initialize ListObject
Dim tbl As ListObject
'Add email information to tbl_email_data
Public Sub addDataToEmailTable()
'GetDefaultFolder(6) is "Inbox" of whoever is signed into Outlook desktop version.
'Does not account for subfolders in Inbox and does not work with Web Outlook version.
Set appOL = CreateObject("Outlook.Application")
Set appNS = appOL.GetNamespace("MAPI")
Set appFolder = appNS.GetDefaultFolder(6)
'initialize table
Set tbl = ThisWorkbook.Worksheets("Email").ListObjects("tbl_email_data")
Dim rowCount As Long
rowCount = 1
If tbl.DataBodyRange Is Nothing Then
tbl.ListRows.Add
End If
'loop through emails and put information into tbl_email_data
For Each email In appFolder.Items
If email.Unread = True Then
tbl.DataBodyRange.Cells(rowCount, 1).Value2 = "Unread"
Else
tbl.DataBodyRange.Cells(rowCount, 1).Value2 = "Read"
End If
tbl.DataBodyRange.Cells(rowCount, 2).Value2 = email.SenderName
tbl.DataBodyRange.Cells(rowCount, 3).Value2 = email.SentOn
tbl.DataBodyRange.Cells(rowCount, 4).Value2 = email.Subject
rowCount = rowCount + 1
Next email
End Sub
I was going to create a userform with a comboBox so when selected a textbox fills with item.body.
This does not account for embedded images, and HTML formatted messages.
I saw Outlook has a method for mailitem that opens the email directly without exiting Excel.

Answer 1

So I figured out how to call the MailItem.Display method based on a table that represents email information in the Inbox folder of Outlook. Lots of trial and error but I got it to work. Below is the full code for the module that will handle all of this.
Option Explicit
Public excelInbox As Collection
Dim appOL, appNS, appInbox, appItem As Object
Public isOnline As Boolean
Public Function checkConnection(status As Boolean)
Set appOL = CreateObject("Outlook.Application")
Set appNS = appOL.GetNameSpace("MAPI")
If appNS.Offline = True Then
MsgBox "Outlook account is not connected to Exchange server. Please verify network connection to get updated Inbox preview"
status = False
Set appNS = Nothing
Set appOL = Nothing
Else
MsgBox "Outlook account is online"
status = True
End If
Set appInbox = appNS.GetDefaultFolder(6)
Set excelInbox = New Collection
End Function
Public Sub makeExcelInbox()
Call checkConnection(isOnline)
If isOnline <> True Then Exit Sub
Set appInbox = appNS.GetDefaultFolder(6) '6 is the enumeration for Inbox root folder in Outlook.
'loop and place only emails into excel Inbox.
For Each appItem In appInbox.Items
If appItem.Class = 43 Then excelInbox.Add appItem '43 represents a mail item in Outlook.
Next appItem
End Sub
Public Sub makeEmailPreviewTable()
Call makeExcelInbox
If excelInbox.Count <> 0 Then
Dim tbl As ListObject
Dim rowCount As Integer
Set tbl = ws_email.ListObjects("tbl_emailData")
rowCount = 1
For Each appItem In excelInbox
If appItem.Unread = True Then
tbl.DataBodyRange.Cells(rowCount, 1).Value2 = "Unread"
Else
tbl.DataBodyRange.Cells(rowCount, 1).Value2 = "Read"
End If
tbl.DataBodyRange.Cells(rowCount, 2).Value2 = appItem.SenderName
tbl.DataBodyRange.Cells(rowCount, 3).Value2 = appItem.SentOn
tbl.DataBodyRange.Cells(rowCount, 4).Value2 = appItem.Subject
rowCount = rowCount + 1
Next appItem
Set tbl = Nothing
ElseIf excelInbox.Count = 0 Then MsgBox "No messages to show in Inbox Preview."
End If
End Sub
Public Function getEmailForDisplay(Target As Range)
'Call makeExcelInbox
For Each appItem In excelInbox
If Target.Value = appItem.Subject Then appItem.Display
Next appItem
End Function
I used the selection change event in the worksheet that has the table to pass the target range value to a function that checks if that value is the same as the subject property of an email in the inbox. It is not the prettiest code, but for any others that come across this with a similar problem this should at least get you on the right path. Here is the worksheet code for event below.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Check for selection of a cell in tbl_emailData column Subject, then pass the value to a function.
Dim rng As Range
Dim tableRange As Range
Set tableRange = ListObjects("tbl_emailData").DataBodyRange
Dim rowCount As Long
rowCount = 1
If Intersect(Target, tableRange) Is Nothing Then Exit Sub
'check for valid target location
For Each rng In tableRange
On Error GoTo ErrorHandler
If Target = tableRange(rowCount, 4) Then
Call getEmailForDisplay(Target)
Else
rowCount = rowCount + 1
End If
Next rng
ErrorHandler:
Exit Sub
End Sub
Just an important note, I am still designing this program so if you sample the code you have to make sure you have a table called "tbl_emailData" and a worksheet called "ws_email". Then when you want to run the code, make sure to run the sub "makeEmailPreviewTable" first. In my design the worksheets and cells will all be locked so only the subject column cells will be selectable, this prevents run-time errors in case the user selects more than one cell.
Update: Added errorhandling to the selection event to ignore multi-selection errors. This will ignore, and then when a proper cell is selected then display the email in a Outlook modal.