Link Outlook to Access

I would like to add a button to Outlook that will copy/import information in an individual email to an MS Access database. We currently have a pretty well-developed Access application that has been developed in VBA.

However, I am at a loss as to the best approach to take when trying to create the button (VSTO, COM, Addon; I am not familiar with any of these technologies).

What is the best approach for this?

Solution

Here you have some of my own code scanning a functional mailbox and inserting email data in an MS Access database.

Put this in a stand-alone module in Outlook
Add a the reference "Microsoft Office x.0 Access database engine Object Library"
Adapt the three constants on top of it
Create a table in your MS Access DB with fields Subject (string) and TS (date)
optionally, adapt the code in sub My_Stuff()
Run the code in sub SCAN_MAILBOX()

After some inevitable tweaking following your environment, it will populate your table with all the subject/receivedtime of all mails in your inbox:

Option Explicit

Const DB_PATH = "C:\thepath\YourDatabase.accdb"
Const DB_TABLE = "Your_Table"

Const MAILBOX_TO_SCAN = "Your mailbox Name"

Public Sub SCAN_MAILBOX()

    ' To perform My_Stuff on the Inbox, do :
    My_Stuff "Inbox"

    ' To perform My_Stuff on any folder/subfolder of the mailbox, do :
    ' My_Stuff "Inbox/folder/subfolder"

End Sub


Private Sub My_Stuff(strMailboxSubfolder As String)

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.NameSpace
    Dim Mailbox As Outlook.MAPIFolder
    Dim folderInbox As Outlook.MAPIFolder
    Dim folderToProcess As Outlook.MAPIFolder
    Dim folderItems As Outlook.Items
    Dim oEmail As Outlook.MailItem

    Dim WS As DAO.Workspace
    Dim DB As DAO.Database

    Dim e As Long
    Dim tot As Long

    On Error GoTo Err_Handler

    Set WS = DBEngine.Workspaces(0)
    Set DB = WS.OpenDatabase(DB_PATH)

    Set objNamespace = Application.GetNamespace("MAPI")
    Set Mailbox = objNamespace.Folders(MAILBOX_TO_SCAN)

    Set folderToProcess = GetFolder(strMailboxSubfolder, Mailbox)
    Set folderItems = folderToProcess.Items

    tot = folderToProcess.Items.Count

    folderToProcess.Items.Sort "ReceivedTime", True

    For e = tot To 1 Step -1

        Set oEmail = folderItems(e)

        ' Some of the oEmail usefull properties :
        Debug.Print oEmail.Subject
        Debug.Print oEmail.ReceivedTime

        ' INSERT email Subject and Received timestamp in an Access database
        DB.Execute "INSERT INTO " & DB_TABLE & " ([SUbject],[TS]) VALUES ('" & Trim(oEmail.Subject) & "',#" & Format(oEmail.ReceivedTime, "MM/DD/YYYY hh:nn:ss") & "#)"

        Set oEmail = Nothing

        DoEvents
    Next


Exit_Sub:

    Set folderItems = Nothing
    Set folderToProcess = Nothing
    Set Mailbox = Nothing
    Set objNamespace = Nothing
    Set DB = Nothing
    Set WS = Nothing

    Exit Sub

Err_Handler:
    MsgBox Err.Description, vbExclamation
    Resume Exit_Sub
    Resume

End Sub


Private Function GetFolder(strFolderPath As String, ByRef Mailbox As Outlook.MAPIFolder) As MAPIFolder

  Dim colFolders As Outlook.Folders
  Dim objFolder As Outlook.MAPIFolder
  Dim arrFolders() As String
  Dim I As Long
  On Error Resume Next

  strFolderPath = Replace(strFolderPath, "/", "\")
  arrFolders() = Split(strFolderPath, "\")

  Set objFolder = Mailbox.Folders.Item(arrFolders(0))
  If Not objFolder Is Nothing Then
    For I = 1 To UBound(arrFolders)
      Set colFolders = objFolder.Folders
      Set objFolder = Nothing
      Set objFolder = colFolders.Item(arrFolders(I))
      If objFolder Is Nothing Then
        Exit For
      End If
    Next
  End If

  Set GetFolder = objFolder
  Set colFolders = Nothing

End Function

I won't cover how to add a button to run the code in this chapter; that's a bit too much. I have shown you enough to experiment and achieve what you want quickly.