Hyperlink Saved Outlook Email to MS Access Table

Status
Not open for further replies.

Hudas

Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Hi!

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

Hudas
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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/
 

Hudas

Member
Outlook version
Outlook 2007
Email Account
Exchange Server
Hello Diane,

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

Code:
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
                           .AddNew
                               !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
                           .Update
                       End If
                   End With
           End Select
       Next mObject
       rs.Close
       'olApp.Application.Quit
       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

Hudas
 

Hudas

Member
Outlook version
Outlook 2007
Email Account
Exchange Server
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!!!!

Code:
'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
                     
                           .AddNew
                         
                               !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 & "#"
                         
                           .Update
                         
                       End If
                     
                       End With
                     
               End Select
         
       Next j
       On Error GoTo 0
   Next i
     
 
ExitSub:
     
 
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, "")
     
 
ExitFunction:
   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
     
 
ExitSub:
   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
     
 
ExitFunction:
   Set objShell = Nothing
     
 
End Function
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Re: Solved: Hyperlink Saved Outlook Email to MS Access Table

Thanks for sharing!
 
Status
Not open for further replies.
Thread starter Similar threads Forum Replies Date
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 New Slipstick.com Articles 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
C Outlook 2010 hyperlink blocked in Windows 7 Home Premium Using Outlook 2
C cannot access hyperlink in Outlook 2007 Using Outlook 1
J Hyperlink error in Outlook 2010 Using Outlook 2
P hyperlink no longer woking Using Outlook 2
D Error message when clicking on hyperlink within email: 'This operation has been canceled due to restrictions in effect on this computer...' Using Outlook 1
B How do I Insert a hyperlink (to company network) in an appointment in Outlook to distribute to attendees? Using Outlook 1
P unable to use hyperlink in outlook 10 Using Outlook 1
D Cannot open Hyperlink in outlook2010 Using Outlook 3
S Outlook 2007 will not show files under the folders any longer when creating a hyperlink. No error messages Using Outlook 1
E Hyperlink Problem in Outlook Using Outlook 2
E Opening a hyperlink Using Outlook 1
C Default folder Hyperlink outlook 2007 Using Outlook 2
T I am receiving the following error message on my home computer whenever I try to open a hyperlink in Using Outlook 5
G When forwarding an email that I've received with a hyperlink, the hyperlink stops working- Outlook 2 Using Outlook 3
A When I click a hyperlink in Outlook 2007 I get a message saying action has been closed - refer to administrator.__How do I turn this off? Using Outlook 1
N Hyperlink in outlook 2003 appointment/meeting Using Outlook 1
C Need to know how to allow a hyperlink to work from and email in outlook 2010. Currently they are blocked and telling me to check with administrator. Using Outlook 3
K Inserting a hyperlink into an email will crash Outlook. Using Outlook 1
T Outlook 2007 hangs when cursor passes over a hyperlink Using Outlook 2
K Picture in email shows as hyperlink to an email address Using Outlook 1
M Shortcut Key Needed Working with Dialog Box while Inserting Hyperlink in a Contact Using Outlook 1
S hyperlink error message Using Outlook 1
Y Outlook 2007 crashes while inserting network shared path hyperlink into mail body Using Outlook 8
Similar threads


















































Top