Mail Backup - Automatic Export to MSG Files
Regular creation of backup database copies may seem too time-consuming and utterly pointless, especially considering the fact that most of the time we do not know what version of Outlook we will be using few years from now and if it will support the backup file created today.
However, what we can do today is to make the backup method more automated. The following procedures automatically export our messages to a defined folder on the hard drive (regardless of the profile from which they originated or have been received on).
All the exported messages can be read by simply double-clicking the saved file or copying it to another Outlook (e.g. on a different workstation) without the need to move the database manually and attach the Personal Folder File (PST).
For outgoing mail:
To insert the VBA code open Outlook’s developer module (Alt+F11) and place the following code in the “ThisOutlookSession” class:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Call ExportOutcomingMailToFile(Item)
End Sub
Then, input this code in the newly created module:
Option Explicit
Public Sub ExportOutcomingMailToFile(ByVal Item As Object)
If Item.Class = 43 Then
On Error Resume Next
Dim strDestFolder$: strDestFolder = "c:\Post\Out\ 'Any path
Call MakeWholePath(strDestFolder)
On Error GoTo 0
Dim strSubject$: strSubject = RemoveInvalidChar(Left(Item.Subject, 100))
Dim strDate$: strDate = Format(Item.CreationTime, "YYYY-DD-MM_HH-MM")
Dim strFileName$: strFileName = strDate & " " & strSubject & ".msg"
Item.SaveAs strDestFolder & strFileName, olMSG
End If
End Sub
Public Function RemoveInvalidChar(str As String)
Dim f&
For f = 1 To Len(str)
str = Replace(str, Mid$("\:?""<>|*", f, 1), vbNullString)
Next
str = Replace(str, vbTab, vbNullString)
str = Replace(str, vbCrLf, vbNullString)
RemoveInvalidChar = str
End Function
Public Function FileExists(FilePath As String) As Boolean
On Error GoTo blad
FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
Exit Function
blad:
FileExists = False
End Function
Public Sub MakeWholePath(FileWithPath As String)
Dim x&, PathToMake$ 'by OShon
For x = LBound(Split(FileWithPath, "\)) To UBound(Split(FileWithPath, "\)) - 1
PathToMake = PathToMake & "\ & Split(FileWithPath, "\)(x)
If Right$(PathToMake, 1) <> ":" Then
If FileExists(Mid(PathToMake, 2, Len(PathToMake))) = False Then _
MkDir Mid(PathToMake, 2, Len(PathToMake))
End If
Next
End Sub
For incoming mail:
You can create a rule in Outlook that will selectively limit the export in the built-in creator by placing the following code in the module (attaching the functions described above):
Sub ExportIncomingMailToFile(item As MailItem)
On Error Resume Next
Dim strDestFolder$: strDestFolder = "c:\Post\In\ ' your any path
Call MakeWholePath(strDestFolder)
On Error GoTo 0
Dim strSubject$: strSubject = RemoveInvalidChar(Left(item.Subject, 100))
Dim strDate$: strDate = Format(item.CreationTime, "YYYY-DD-MM_HH-MM")
Dim strFileName$: strFileName = strDate & " " & strSubject & ".msg"
item.SaveAs strDestFolder & strFileName, olMSG
End Sub
http://outlook-center.com/article/upload/450.png
Fig. 1. Rule exporting the messages to an .msg file.
All the parameters from the above procedures can be edited and modified at will, using the Mailitem object properties. For incoming mail we can use MS Outlook’s rule creator.
If you are not experienced in macro installation in Microsoft Outlook, please refer to the article Installation and running macros
(c) Shon Oskar
© All rights reserved. No part or whole of this article may not be reproduced or published without prior permission.
Oryginal article publicate at this page