Import EML to Oulook PST

Author Message

  • Total Posts : 16
  • Joined: 11/9/2004
  • Location: Portland, OR
  • Status: offline
Import EML to Oulook PST Saturday, June 03, 2006 1:22 AM (permalink)
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
   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")
   End If
   On Error GoTo ProcError
   DoCmd.Hourglass True
   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"
      GoTo ProcExit
   End If
   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...
   'SysCmd acSysCmdClearStatus
   DoCmd.Hourglass False
   'clean up
   Set oSafeMail = Nothing
   Set oMailItem = Nothing
   Set oMF = Nothing
   Set oNS = Nothing
   Set oApp = Nothing
   Exit Sub
   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...
   Resume 0
End Sub
'the following in another code module for the BrowseFolder() function
Option Compare Database
Option Explicit
'************** 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
'Terry Kreft
'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?")
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type
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) _
                                           As Long
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
   With bi
      .hOwner = hWndAccessApp
      .lpszTitle = szDialogTitle
   End With
   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 = ""
   End If
End Function
'*********** Code End *****************

    Online Bookmarks Sharing: Share/Bookmark

    Jump to:

    Current active users

    There are 0 members and 1 guests.

    Icon Legend and Permission

    • New Messages
    • No New Messages
    • Hot Topic w/ New Messages
    • Hot Topic w/o New Messages
    • Locked w/ New Messages
    • Locked w/o New Messages
    • Read Message
    • Post New Thread
    • Reply to message
    • Post New Poll
    • Submit Vote
    • Post reward post
    • Delete my own posts
    • Delete my own threads
    • Rate post

    2000-2019 ASPPlayground.NET Forum Version 3.9