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

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