Backing up MS Outlook emails along with Meta-data

Download sourcecode (804 kb)

Introduction

Outlook Logger is a console base application that scans your MS Outlook Inbox folder and saves the meta-data of your emails in MS Access database For Example: sender information, Email Subject, Attachments Count, Message sent and Receive time, Message Importance etc. Further it also saves the TO,CC,BCC information for each email in another table.

Application creates an outlook .msg and save i Emails directory. Emails are saved in sub-folders named as recieved date of emails.

Finally it moves Email from inbox to "Personal Folders\InBoxBackup" Folder.

Outlook Redemption has been used to get rid of Security Prompts in  outlook.

Not a tough thing to do!! So move on...

Note: Following Steps to run application
---------------------------------------
1. Register redemption.dll (provided with code) using regsvr32 on your Computer.
2. Create Personal Folders\InBoxBackup Folder in outlook

Database Side:

1) 'Outlook_logger_tmp' : Temporary Storage of EntryID of all emails in inbox.
2) 'Outlook_logger_message': Store Emails Meta-data as described above.
3) 'Outlook_logger_Recipients': Stores the information of Emails Recipients, as To,Bcc and CC.
4) 'Outlook_logger_Attachments': Attachments data of emails

EntryID is the property of Outlook that uniquely identifies each email (in a folder). I have appended sender email address to apply more uniqueness for example:

0000000094991EDBACA62B41A7E88CDEC57A942824002000-sajid.mahmood@hotmail

Every Email has its own ID and tracked against it. Linked in tables and also the .msg file name.

Functionality
a. NEW EMAILS IDENTIFICATION
-------------------------------
 a) Delete All Recs from outlook_logger_tmp table.
 b) Get EntryID for each email from Inbox in 'Outlook_logger_tmp'.
 c) Compare EntryIDs in outlook_logger_tmp with 'Outlook_logger_message' table and identify New Emails (EntryIDs).
 d) Save new EntryIDs in an ArrayList.

b. Start Processing each Email one by one
----------------------------------------------
 a) Save Emails Meta-deta in outlook_logger_message table.
 a) Save To,CC,BCC to 'OUTLOOK_LOGGER_RECIPIENTS' table.
 b) Check if attachment then save the attachment metadata in 'OUTLOOK_LOGGER_ATTACHMENTS'.
 c) Save Email File
 d) Move Email in backup folder

Lets jump into source Code:

Sub Main()

Try

'Outlook Settings

Dim outlook_Profile As String = "Default Outlook Profile"

oApp = New Outlook.Application()

oNS = oApp.GetNamespace("mapi")

oNS.Logon(outlook_Profile, , False, True)

destinationFolder = CurDir() & "\Emails"

'You must first Create the following folder in MS Outlook manualy

BackUpFolder = ConfigurationSettings.AppSettings.Get("BackUpFolder")

'Database Configurations

conString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurDir() & "\OutLook_DB.mdb" & ";User Id=admin;Password=;"

dbCon = New OleDbConnection(conString)

dbCon.Open()

'Actual Processing

mainCode()

Catch ex As System.Exception

Console.WriteLine(ex.Message)

Catch olkExp As COMException

Console.WriteLine(olkExp.Message)

End Try

If dbCon.State = ConnectionState.Open Then

dbCon.Close()

End If

oNS.Logoff()

End Sub

 
Private Sub mainCode()
'FIRST CHECK FOR DESTINATION FOLDER of Emails
If Not checkDirPath(destinationFolder) Then
Console.WriteLine("Destination directory " & destinationFolder & " - Not Accessable")
Exit Sub
End If
Const olFolderInbox = 6
Dim inboxFolder As Outlook.MAPIFolder = oNS.GetDefaultFolder(olFolderInbox)
Dim sInboxItem As New Redemption.SafeMailItem()
Dim inboxItems As Outlook.Items = inboxFolder.Items
Dim rCurrentUser As New Redemption.SafeCurrentUser()
Dim currentUserEmailAddr, insertQuery As String
'Get Current User Email Address
currentUserEmailAddr = rCurrentUser.Address.ToLower
Console.WriteLine("Started Scanning Emails on : " & currentUserEmailAddr)
'DELETE ALL MAILS EntryIDs DATA (OLD) FROM TEMP TABLE
deleteTmpTable()
'Store Inbox EntryIDs Emails in Tmp Table
loadTmpTable(inboxItems)
Console.WriteLine("Total " & inboxItems.Count & " emails found in Inbox")
'Store New Emails's EntryIDs 
Dim mailIDs As ArrayList = getNewEntryIDs()
Dim mailID As String
Dim id As String
'Now Process Emails One by One
For Each mailID In mailIDs
If inboxItems.Count <> 0 Then
sInboxItem.Item = inboxItems.GetFirst
Else
Exit For
End If
While TypeName(sInboxItem.Item) <> "Nothing"
id = sInboxItem.EntryID & "-" & sInboxItem.SenderEmailAddress
If id = mailID Then
Dim msgRecvDate As Date = CDate(sInboxItem.ReceivedTime)
Dim FolderName As String = DatePart(DateInterval.Year, msgRecvDate) & "-" & DatePart(DateInterval.Month, msgRecvDate) & "-" & DatePart(DateInterval.Day, msgRecvDate)
Dim destSubFolder As String = destinationFolder & "\" & FolderName
MkFolder(destSubFolder)
logMessage(mailID, sInboxItem, currentUserEmailAddr, destSubFolder)
'Save Recipients data
saveRecipientsInfo(mailID, sInboxItem, "TO")
saveRecipientsInfo(mailID, sInboxItem, "CC")
saveRecipientsInfo(mailID, sInboxItem, "BCC")
'Save Attachments Meta-Data
saveAttachments(mailID, sInboxItem)
'Save Message
saveMessageFile(mailID, sInboxItem, destSubFolder)
'Move Email to Backup Folder
moveToBackup(sInboxItem)
End If
sInboxItem.Item = inboxItems.GetNext()
End While
Next
End Sub
 

 
Private Sub logMessage(ByVal mailID As String, ByRef sInboxItem As Redemption.SafeMailItem, ByVal currentUserEmailAddr As String, ByVal destSubFolder As String)
'Description
'============
'Save the Message meta-data in the database
Console.WriteLine("Processing : " & sInboxItem.Subject & " + " & sInboxItem.SenderEmailAddress)
Dim subject As String = Replace(sInboxItem.Subject, "'", "''")
Dim senderName As String = Replace(sInboxItem.SenderName, "'", "''")
Dim senderEmailAddr As String = Replace(sInboxItem.SenderEmailAddress, "'", "''")
Dim msgRecvDate As Date = CDate(sInboxItem.ReceivedTime)
Dim abc As Date = CDate(sInboxItem.SentOn)
Dim insertQuery As String
insertQuery = "insert into outlook_logger_message "
insertQuery += " (USER_EMAILADDR, MSG_ID, MSG_SENDER_EMAILADDR, MSG_SENDER_NAME, MSG_SUBJECT, "
insertQuery += " MSG_FILE_NAME, MSG_FILE_PATH, MSG_ATTACHMENT_COUNT,MSG_SEND_DATE, MSG_RECV_DATE, "
insertQuery += " MSG_SIZE, MSG_IMPORTANCE,LOG_DATE,MSG_READ_FLAG) "
insertQuery += " values "
insertQuery += " ('" & currentUserEmailAddr & " ','" & mailID & "','" & senderEmailAddr & "','" & senderName & "','" & subject & "' ,"
insertQuery += " '" & mailID & ".msg" & "','" & destSubFolder & "'," & sInboxItem.Attachments.Count & ", #" & CDate(sInboxItem.SentOn) & "#,#" & CDate(sInboxItem.ReceivedTime) & "#, "
insertQuery += sInboxItem.size & "," & sInboxItem.Importance & " ,#" & Now() & "#,'N')"
Dim cmd As New OleDbCommand(insertQuery, dbCon)
cmd.ExecuteNonQuery()
End Sub
 

 
'Description
'============
'Save the Recipients Information in the database along with EntryID/mailID

Private Sub saveRecipientsInfo(ByVal mailID As String, ByRef sInboxItem As Redemption.SafeMailItem, ByVal recipientType As String)
Dim contactsLongStr As New ArrayList()
Dim insertQuery As String
Dim recipientsLine As String
If recipientType = "TO" Then
recipientsLine = sInboxItem.To
ElseIf recipientType = "CC" Then
recipientsLine = sInboxItem.CC
ElseIf recipientType = "BCC" Then
recipientsLine = sInboxItem.BCC
End If
If recipientsLine <> "" Then
Dim Contacts As String = Replace(recipientsLine, "'", "")
contactsLongStr = divideContacts(Contacts, 1000)
Dim contactLine As String
Dim cmd As New OleDbCommand()
cmd.Connection = dbCon
For Each contactLine In contactsLongStr
insertQuery = "insert into OUTLOOK_LOGGER_RECIPIENTS (" & _
"MSG_ID, RECIPIENTS_EMAILADDR, TOORCCORBCC " & _
" ) values ('" & _
mailID & "','" & contactLine & "','" & recipientType & "')"
cmd.CommandText = insertQuery
cmd.ExecuteNonQuery()
Next
cmd.Dispose()
End If
End Sub
 

 
Private Sub saveAttachments(ByVal mailID As String, ByRef sInboxItem As Redemption.SafeMailItem)
'Description
'============
'Saves the attachments Meta-data
Dim x As Integer
Dim insertQuery As String
If sInboxItem.Attachments.Count > 0 Then
Dim cmd As New OleDbCommand()
cmd.Connection = dbCon
For x = 1 To sInboxItem.Attachments.Count
insertQuery = "insert into OUTLOOK_LOGGER_ATTACHMENTS (" & _
"MSG_ID, ATTACHMENT_NAME, ATTACHMENT_SIZE " & _
" ) values ('" & _
mailID & "','" & sInboxItem.Attachments(x).FileName & "'," & sInboxItem.Attachments(x).Size & ")"
cmd.CommandText = insertQuery
cmd.ExecuteNonQuery()
Next
cmd.Dispose()
End If
End Sub

 

 
Private Sub saveMessageFile(ByVal mailID As String, ByRef sInboxItem As Redemption.SafeMailItem, ByVal destSubFolder As String)
'Description
'============
'a) Stores the Message file (.msg) in the destination Folder
'Folder Name is Emails\{Received Date} 
'For Example Example : Emails\2005-10-31
'MSG File Path Example : Emails\2005-10-31\0000000094991EDBACA62B41A7E88CDEC57A942824002000-sajid.mahmood@millips.com.pk.msg
sInboxItem.SaveAs(destSubFolder & "\" & mailID & ".msg")
End Sub
 

Private Sub moveToBackup(ByRef sInboxItem As Redemption.SafeMailItem)
'Description
'============
'Move email from inbox to Backup Folder, This helps in fast scanning in future.
Dim bkfolder As Outlook.MAPIFolder
bkfolder = GetFolder(BackUpFolder)
sInboxItem.move(bkfolder)
End Sub

Conclusion