We recently upgraded from MARC2 to MARC3 and are generally pleased. Our 'friends' at the SEC requested some email communication and prefered the mails in a PST. I thought I'd share the solution.
Using the MARC3 Export wizard to select and export the mails as EML format and running some VBA to automate Outlook and import the eml into the 'Drafts' folder on the machine running this code as Outlook mailitems. The Redemption.dll can import and export eml and msg and rtf formats, nifty!
'code in an Access Code module, any Office product would do...
Public Sub ImportEml()
'Import *.eml files into Outlook, they end up in the Drafts folder
'using the Safe Redemption Objects from www.dimastr.com/redemption
On Error GoTo ProcError
Dim strActiveObjectName As String
strActiveObjectName = Application.CurrentObjectName & " ImportEml"
'set references for intellisense
' Dim oApp As Outlook.Application
' Dim oNS As Outlook.NameSpace
' Dim oMF As Outlook.MAPIFolder
' Dim oMailItem As Outlook.MailItem
' Dim oSafeMail As Redemption.SafeMailItem
'use this way for late binding, no references set
Dim oApp As Object
Dim oNS As Object
Dim oMF As Object
Dim oMailItem As Object
Dim oSafeMail As Object
Dim strEMLFolderName As String
Dim strEMLFileName As String
Dim i As Long
'Get reference to the Outlook application running or start it
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
If oApp Is Nothing Then
Set oApp = CreateObject("Outlook.Application")
On Error GoTo ProcError
Set oNS = oApp.GetNamespace("MAPI")
Set oMF = oNS.GetDefaultFolder(6) '6 = olFolderInbox, doesn't matter, new messages go to Drafts
'get folder location, old BrowseFolder() code is compatible with Access 2000
strEMLFolderName = BrowseFolder("Please browse and select the folder with exported EML files")
'make first file name
strEMLFileName = Dir(strEMLFolderName & "\*.eml")
If strEMLFileName = "" Then
MsgBox "Check for proper file location, I didn't find any *.eml"
Do Until strEMLFileName = ""
'i = i + 1
'SysCmd acSysCmdSetStatus, i 'show counter in Access Status bar
Set oMailItem = oMF.Items.Add(0) ' 0 = olMailitem
Set oSafeMail = CreateObject("Redemption.SafeMailItem")
oSafeMail.Item = oMailItem
oSafeMail.Import strEMLFolderName & "\" & strEMLFileName, 1024 '1024 = eml format
oMailItem.Save 'saves as msg format in Outlook Drafts folder
strEMLFileName = Dir() 'grab next eml...
Set oSafeMail = Nothing
Set oMailItem = Nothing
Set oMF = Nothing
Set oNS = Nothing
Set oApp = Nothing
MsgBox "An error has occured in " & strActiveObjectName & ": " & "Error number " & Err.Number & ": " & Err.Description _
& vbCrLf & vbCrLf & "If this problem persists, note the error message and call your programmer.", , "Ooops . . . (unexpected error)"
'let's go to the line and see what the problem is...
'the following in another code module for the BrowseFolder() function
Option Compare Database
'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'Code courtesy of
'Save the module with any name. Use the following example as an illustration on how to call the function.
'Dim strFolderName as string
'strFolderName = BrowseFolder("What Folder you want to select?")
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
'?dir(BrowseFolder("Please Select the folder with exported *.eml files")& "\*.eml")
Dim x As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If x Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
BrowseFolder = ""
'*********** Code End *****************