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?
Here you have some of my own code scanning a functional mailbox and inserting email data in an MS Access database.
Subject (string) and TS (date)My_Stuff()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.
I would use an add-in (VBA) to test it, and then move to something more substantial should you desire. Playing around, you could use something like this:
Sub EMAIL_TEST()
Dim olMail As MailItem
Set olMail = ActiveInspector.CurrentItem
' Pass properties from mail to access here
End Sub
