Hyperlink Saved Outlook Email to MS Access Table

Not open for further replies.


Outlook version
Email Account
Exchange Server

I am hoping someone could help me with my problem or could point me to the right direction.

When an Email is received in MS Outlook, the details(Entry ID, Sender, ReceivedTime etc) of that email is saved in a MS Access table. And because there is no way for us to create .PST files (Archive) of those emails what we do is just we save those in our personal drive. What I am hoping to do is to automatically create a hyperlink to those emails simultaneously to the MS Access table using the Entry ID as the identifier where to put the hyperlink. Creating a hyperlink one by one will be very troublesome because we many emails a day thats why i hoping if there is a faster way.

Attaching the email to the table is not a good idea because it will make the file larger and we have many emails per day. Any ideas will be very much appreciated.

Thank you

How are you updating the database and saving the email to the hard drive? You'll need to add the file name and path to the database, which you can do with VBA. I'd use a macro to save the email to the hard drive - it will have the path, which you insert into the database.

I have a macro that can save messages here: http://www.slipstick.com/developer/saving-messages-to-the-hard-drive-using-vba/
Hello Diane,

Below is the code I am using to update the dabase with email details.

Public Function oImportUnread()    Dim olApp As Outlook.Application
   Dim inBox As Outlook.MAPIFolder
   Dim inBoxItems As Outlook.Items
   Dim mObject As Object
   Dim rs As DAO.Recordset
   Dim strSQL As String
   Set olApp = CreateObject("Outlook.Application")
   Set inBox = olApp.GetNamespace("Mapi").Folders("GROUP MAILBOX").Folders("Inbox")
   Set inBoxItems = inBox.Items
   Set db = CurrentDb()
       For Each mObject In inBoxItems
           iTemClass = mObject.Class
           Select Case iTemClass
               Case "43"
                   strSQL = "SELECT * FROM [tbl_Inbox] WHERE [tbl_Inbox].EntryID = '" & mObject.EntryID & "'"
                   Set rs = db.OpenRecordset(strSQL)
                   With rs
                       If .RecordCount = 0 Then
                               !EntryID = mObject.EntryID
                               !SenderName = mObject.SenderName
                               !SentOn = mObject.SentOn
                               !SenderEmailAddress = mObject.SenderEmailAddress
                               '!Sender = mObject.Sender
                               !To = mObject.To
                               !CC = mObject.CC
                               !ReceivedTime = ReceivedTime
                               !Subject = mObject.Subject
                               !Body = mObject.Body
                               !HTMLBody = mObject.HTMLBody
                       End If
                   End With
           End Select
       Next mObject
       Set olApp = Nothing
       Set inBox = Nothing
       Set inBoxItems = Nothing 
End Function

I will try your suggestion and let you know how it goes

Thank you

Solved: Hyperlink Saved Outlook Email to MS Access Table

Hi Diane,

Below is the working code. Thank you very much!

The below code gets the email details and saved it to database then email is saved to a specific location then a hyperlink is added referencing that email. We can now delete the emails in Outlook and we have a database of all our emails. Thank you! Diane!!!!

'Original  Diane Poremsky'Website: http://www.slipstick.com/developer/saving-messages-to-the-hard-drive-using-vba/ 
'Website: https://forums.slipstick.com/threads/91623-Hyperlink-Saved-Outlook-Email-to-MS-Access-Table 
Dim StrSavePath         As String 
Private Sub SaveAllEmails_ProcessAllSubFolders()
   Dim i               As Long
   Dim j               As Long
   Dim n               As Long
   Dim StrSubject      As String
   Dim StrName         As String
   Dim StrFile         As String
   Dim StrReceived     As String
   Dim StrFolder       As String
   Dim StrSaveFolder   As String
   Dim StrFolderPath   As String
   Dim iNameSpace      As NameSpace
   Dim myOlApp         As Outlook.Application
   Dim SubFolder       As MAPIFolder
   Dim mItem           As MailItem
   Dim FSO             As Object
   Dim ChosenFolder    As Object
   Dim Folders         As New Collection
   Dim EntryID         As New Collection
   Dim StoreID         As New Collection
   Dim acAppdB As DAO.Database
   Dim rs As DAO.Recordset
   Dim strSQL As String
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set myOlApp = Outlook.Application
   Set iNameSpace = myOlApp.GetNamespace("MAPI")
   Set ChosenFolder = iNameSpace.PickFolder
   If ChosenFolder Is Nothing Then 
GoTo ExitSub:
   End If
BrowseForFolder StrSavePath
   Call GetFolder(Folders, EntryID, StoreID, ChosenFolder)
   For i = 1 To Folders.Count
       StrFolder = StripIllegalChar(Folders(i))
       n = InStr(3, StrFolder, "\") + 1
       StrFolder = Mid(StrFolder, n, 256)
       StrFolderPath = StrSavePath & "\" & StrFolder & "\"
       StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
       If Not FSO.FolderExists(StrFolderPath) Then
           FSO.CreateFolder (StrFolderPath)
       End If
       Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
       'On Error Resume Next
       Set acAppdB = DBEngine(0).OpenDatabase("my database path and filename")
       For j = 1 To SubFolder.Items.Count
           Set mItem = SubFolder.Items(j)
           iTemClass = mItem.Class
               Select Case iTemClass
                   Case "43"
                   strSQL = "SELECT * FROM [tbl_eMail_Archive] WHERE [tbl_eMail_Archive].EntryID = '" & mItem.EntryID & "'"
                   Set rs = acAppdB.OpenRecordset(strSQL)
                       With rs
                       If .RecordCount = 0 Then
                               !EntryID = mItem.EntryID
                               !SenderName = mItem.SenderName
                               !SentOn = mItem.SentOn
                               !SenderEmailAddress = mItem.SenderEmailAddress
                               '!Sender = mItem.Sender
                               !To = mItem.To
                               !CC = mItem.CC
                               !ReceivedTime = ReceivedTime
                               !Subject = mItem.Subject
                               !Body = mItem.Body
                               !HTMLBody = mItem.HTMLBody
                               StrReceived = Format(mItem.ReceivedTime, "YYYYMMDD-hhmm")
                               StrSubject = mItem.Subject
                               StrName = StripIllegalChar(StrSubject)
                               StrFile = StrSaveFolder & StrReceived & "_" & StrName & ".msg"
                               StrFile = Left(StrFile, 256)
                               mItem.SaveAs StrFile, 3
                               !oMailLink = "#" & StrFile & "#"
                       End If
                       End With
               End Select
       Next j
       On Error GoTo 0
   Next i
End Sub
Function StripIllegalChar(StrInput)
   Dim RegX            As Object
   Set RegX = CreateObject("vbscript.regexp")
   RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
   RegX.IgnoreCase = True
   RegX.Global = True
   StripIllegalChar = RegX.Replace(StrInput, "")
   Set RegX = Nothing
End Function
Sub GetFolder(Folders As Collection, EntryID As Collection, StoreID As Collection, Fld As MAPIFolder)
   Dim SubFolder       As MAPIFolder
   Folders.Add Fld.FolderPath
   EntryID.Add Fld.EntryID
   StoreID.Add Fld.StoreID
   For Each SubFolder In Fld.Folders
       GetFolder Folders, EntryID, StoreID, SubFolder
   Next SubFolder
   Set SubFolder = Nothing
End Sub

Function BrowseForFolder(StrSavePath As String, Optional OpenAt As String) As String
   Dim objShell As Object
   Dim objFolder 
Dim enviro 
enviro = CStr(Environ("USERPROFILE")) 
Set objShell = CreateObject("Shell.Application") 
Set objFolder = objShell.BrowseForFolder(0, "Please choose a folder", 0, enviro & "\My Documents\") 
StrSavePath = objFolder.self.Path
   On Error Resume Next
   On Error GoTo 0
   Set objShell = Nothing
End Function
Re: Solved: Hyperlink Saved Outlook Email to MS Access Table

Thanks for sharing!
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
V Embedding hyperlink into Word document Using Outlook 2
Y Open and Save Hyperlink Files in multiple emails Outlook VBA and Custom Forms 9
L Ignore hyperlink from being flagged as false pattern Outlook VBA and Custom Forms 3
D Custom form with html hyperlink Outlook VBA and Custom Forms 7
N open the hyperlink in Outlook directly instead of browser Using Outlook 1
M VBA Rule for removing all body but hyperlink then forwarding Outlook VBA and Custom Forms 9
M How to view the URL for a hyperlink? Using Outlook 1
A Add Hyperlink to Task Outlook VBA and Custom Forms 11
Q Why can't I copy image with embedded hyperlink from email to Word Using Outlook 0
P URL Hyperlink not working correctly in Outlook 2003 Using Outlook 10
A Create Macro for hyperlink(email) in message body Outlook VBA and Custom Forms 9
Diane Poremsky Disable the Unsafe Hyperlink Warning when Opening Attachments Using Outlook 0
V Using custom field data in mail body + mailto hyperlink Outlook VBA and Custom Forms 7
C Hyperlink to an Outlook search Using Outlook 1
makinmyway Recent Files Not Updating when Using Insert Hyperlink in Outlook 2013 Using Outlook 0
E Create a URL hyperlink in an Outlook custom form? Outlook VBA and Custom Forms 2
J Macro generating email using default signature and hyperlink Outlook VBA and Custom Forms 5
Witzker HYPERLINK "mailto:test@test.com" in form body Using Outlook 21
D Particular Facebook "Hyperlink" Issue In Office 2010 Outlook (32 bit) Using Outlook 5
S email body without "HYPERLINK" ( vba ) Using Outlook 6
M How to create a hyperlink to to an organizational form Using Outlook 5
J Hyperlink VBA Using Outlook 1
P Can't add a custom hyperlink to toolbar in OL 2010 Using Outlook 1
T Desable Hyperlink on email Using Outlook 3
O Hyperlink formatting lost after replacement in outlook Using Outlook 5
O Hyperlink formatting lost after replacement in outlook Using Outlook 0
G Hyperlink Using Outlook 1
T Hyperlink Issue Using Outlook 2
P Hyperlink to Access record/Form Outlook VBA and Custom Forms 2
M auto click hyperlink?! Outlook VBA and Custom Forms 1
M Auto click a hyperlink Outlook VBA and Custom Forms 2
R Inserting a hyperlink in the bod of an outlook appt. Outlook VBA and Custom Forms 13
K Add Hyperlink in Email Body by VBA Outlook VBA and Custom Forms 1
A Outlook 365 New Appointments All saved to a 365 default calendar on Mac Using Outlook 0
M Extract "Date sent" from emails (saved to folder using drag and drop) Outlook VBA and Custom Forms 1
N Item cannot be saved because it was modified by another user or window, and, Item could not be moved... Using Outlook 0
e_a_g_l_e_p_i Changing where data .pst is saved to Using Outlook 3
L Outlook saved template function too limited Using Outlook 2
P outlook 2008 search box criteria couldn't be saved Using Outlook 2
R Limiting length of saved attachment in VBA Outlook VBA and Custom Forms 2
L Outlook saved email templates Using Outlook 1
T Pictures degrade each time an Outlook item is edited and re-saved Using Outlook 1
N Macro for attachment saved and combine Outlook VBA and Custom Forms 1
S Importing Ribbons Not Saved Using Outlook 7
Cdub27 Your changes to this item couldn't be saved because Server Denied Operation (HTTP 403 Forbidden) Using Outlook 1
C Changing the name of Outlook Messages saved to a folder Using Outlook 1
R Outlook 2010 - Reading Pane and To Do Bar Settings Not Saved on Exit Using Outlook 2
Jessica .msg file saved in network drive appearing in Deleted Items folder Using Outlook 3
B Saved emails in folders I created on left of screen are being erased as I open each folder Using Outlook 0

Similar threads