备份 MS Outlook 邮件及其元数据

下载源代码 (804 kb)

引言

Outlook Logger 是一个控制台应用程序，它扫描您的 MS Outlook 收件箱文件夹，并将您的邮件元数据保存到 MS Access 数据库中。例如：发件人信息、邮件主题、附件数量、消息发送和接收时间、消息重要性等。此外，它还将每封邮件的收件人、抄送和密送信息存储到另一个表中。

应用程序创建 outlook .msg 文件并将其保存在 Emails 目录中。邮件保存在以邮件接收日期命名的子文件夹中。

最后，它将邮件从收件箱移动到“个人文件夹\InBoxBackup”文件夹。

Outlook Redemption 被用于消除 Outlook 中的安全提示。

这并不难！继续吧...

注意：运行应用程序的步骤如下
---------------------------------------
1. 使用 regsvr32 在您的计算机上注册 redemption.dll（随代码提供）。
2. 在 Outlook 中创建“个人文件夹\InBoxBackup”文件夹。

数据库方面

1) 'Outlook_logger_tmp' : 收件箱中所有邮件的 EntryID 的临时存储。
2) 'Outlook_logger_message' : 存储上述描述的邮件元数据。
3) 'Outlook_logger_Recipients' : 存储邮件收件人的信息，如收件人、抄送和密送。
4) 'Outlook_logger_Attachments': 邮件的附件数据

EntryID 是 Outlook 的一个属性，它唯一标识每封邮件（在一个文件夹中）。我将发件人电子邮件地址附加到 EntryID 上，以应用更多的唯一性，例如

0000000094991EDBACA62B41A7E88CDEC57A942824002000-sajid.mahmood@hotmail

每封邮件都有自己的 ID，并与其关联。链接在表中，以及 .msg 文件的名称。

功能
a. 新邮件识别
-------------------------------
 a) 从 outlook_logger_tmp 表中删除所有记录。
 b) 从收件箱中获取每封邮件的 EntryID 到 'Outlook_logger_tmp'。
 c) 将 outlook_logger_tmp 中的 EntryID 与 'Outlook_logger_message' 表进行比较，并识别新的邮件（EntryID）。
 d) 将新的 EntryID 保存到 ArrayList 中。

b. 开始逐一处理每封邮件
----------------------------------------------
 a) 将邮件元数据保存到 outlook_logger_message 表中。
 a) 将收件人、抄送和密送保存到 'OUTLOOK_LOGGER_RECIPIENTS' 表中。
 b) 如果有附件，则将附件元数据保存到 'OUTLOOK_LOGGER_ATTACHMENTS' 中。
 c) 保存邮件文件
 d) 将邮件移动到备份文件夹

让我们深入研究源代码

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

结论