Outlook Redemption: Silent Import with ReceivedTime modification

Question

Please help to automate the process which consists of 2 Subs:

Import - I need to make Silent import without target & destination folder selection dialog. I need to import to my "INBOX/Imported" subfolder in Outlook and want to understand where in this code I can mention it explicitly. I need to grab .EML files from the folder "D:\Emails" without redundant dialogue for folder selection:

Sub Redemp()
Dim objShell: Set objShell = CreateObject("Shell.Application")
Dim objFolder: Set objFolder = objShell.BrowseForFolder(0, "Select the folder containing eml-files", 0)

Dim Item
If (Not objFolder Is Nothing) Then
  Set WShell = CreateObject("WScript.Shell")
  Set objOutlook = CreateObject("Outlook.Application")
  Set Folder = objOutlook.Session.PickFolder
  If Not Folder Is Nothing Then
    For Each Item In objFolder.Items
      If Right(Item.name, 4) = ".eml" And Item.IsFolder = False Then
        Set objPost = Folder.Items.Add(6)
        Set objSafePost = CreateObject("Redemption.SafePostItem")
        objSafePost.Item = objPost
        objSafePost.Import Item.Path, 1024
        objSafePost.MessageClass = "IPM.Note"
        ' remove IPM.Post icon
    Set utils = CreateObject("Redemption.MAPIUtils")
    PrIconIndex = &H10800003
        utils.HrSetOneProp objSafePost, PrIconIndex, 256, True 'Also saves the message
      End If
    Next
  End If
End If

MsgBox "Import completed.", 64, "Import EML"

Set objFolder = Nothing
Set objShell = Nothing
End Sub

Also, it would be great to avoid imported messages appearing in Outlook as if I already started replying to (not very convenient). If I use the above code and select imported message it doesn't look like originally received, but rather looks like text that I reply to.

I need to unify the below code that corrects ReceivedTime property of imported message (or it can modify EML file before import, sequence of actions is not important) with above import procedure.

Sub Redemp_sentreceived()
    Set rSession = CreateObject("Redemption.RDOSession")
    rSession.MAPIOBJECT = Application.Session.MAPIOBJECT
    Set Msg = rSession.GetRDOObjectFromOutlookObject(Application.ActiveExplorer.CurrentFolder)
    For Each Item In Msg.Items
        Item.ReceivedTime = Item.SentOn
        Item.Save
    Next
End Sub

Ultimately imported .EML files should be in target folder with correct ReceivedTime. Many thanks for helping me out in advance!

score 0 · Answer 1 · answered Apr 01 '21 at 04:38

0

There is really no reason to use Safe*Item objects in this case - use RDOSession object, set the MAPIOBJECT property just like you do in the second example.

Off the top of my head:

Set rSession = CreateObject("Redemption.RDOSession")
rSession.MAPIOBJECT = Application.Session.MAPIOBJECT
Set folder = rSession.GetDefaultFolder(plFolderInbox).Folders.Items("Imported")
Set fileFolder = objFSO.GetFolder("D:\Emails")
For Each objFile in fileFolder.Files
    set msg = folder.Items.Add("IPM.Note")
    msg.Sent = true
    msg.Import objFile.Path, 1031
    msg.Save
Next

answered Apr 01 '21 at 04:38

Dmitry Streblechenko

62,942
4
53
78

Looks like `msg.Import objFile.Path, 1031` has problems with Import - the message is getting imported as if it opens the plain .EML file and inserts text in mail body. Would you please advise the way I could combine it with `Safe*Item`? Besides, can we implement original .EML file deletion after it gets imported? – SuperMaximus Apr 01 '21 at 08:20
What is your actual code? To delete an EML file, just call objFile.Delete above – Dmitry Streblechenko Apr 01 '21 at 16:10
I actually tried your suggested variant (thought it would provide all requested functionality). But it does import file raw data, unlike the code from my initial message. Please advise what is wrong? Thanks! – SuperMaximus Apr 01 '21 at 17:08

score 0 · Answer 2 · edited Apr 01 '21 at 18:23

0

The problem was in number pointed in Import (I changed 1031 -> 1024) and now it works like a charm!

Sub MailImport()
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set rSession = CreateObject("Redemption.RDOSession")
rSession.MAPIOBJECT = Application.Session.MAPIOBJECT
Set Folder = rSession.GetDefaultFolder(olFolderInbox)
Set fileFolder = objFSO.GetFolder("D:\Emails")

For Each objFile In fileFolder.Files
    Set msg = Folder.Items.Add("IPM.Note")
    msg.sent = True
    msg.Import objFile.Path, 1024
    msg.ReceivedTime = msg.SentOn
    msg.Save
    objFile.Delete
Next

Set objFSO = Nothing
End Sub

edited Apr 01 '21 at 18:23

Dharman

30,962
25
85
135

answered Apr 01 '21 at 17:30

SuperMaximus

1

So the built-in Redemption importer (1031) could not import the EML files, but 1024 (Outlook imparter if available) could? Can you zip and send a problematic EML file to redemption (at) dimastr (dot) com? Thanks! – Dmitry Streblechenko Apr 03 '21 at 19:16

Outlook Redemption: Silent Import with ReceivedTime modification

2 Answers2