Problem with decryption macro

Jul 29, 2009
Reaction score
Hi all. I am working on a simple Outlook macro and am in need of a little assistance.

This macro enumerates through encrypted messages in a folder, decrypts each message, and then moves the decrypted messages to the "Drafts" folder. After the macro finishes, I export the decrypted messages to a PST file.

Now this macro works like a charm if all the messages in the folder can be opened. However on occasion you'll encounter a message that cannot be decrypted for whatever reason causing the macro to abort during execution. I added some error handling so it can continue processing however I have no way of knowing which messages could not be opened. I'd like to be able to track the invalid messages by moving them to a separate folder as they are encountered. Bear in mind the source folder contains a large number of messages (5000+) so manually sifting through it for such messages would be cumbersome to say the least.

The problem is, I can't find a way to programatically handle such messages. The Save, Move, and Fordward methods of the Outlook.MailItem object don't work for S/MIME messages that can't be opened. I can view some of the attributes of these messages in a debug watch window but can't access any of them with code.

Below is my source code. Would really appreciate any suggestions. Thanks!

Sub ProcessFolder()

Dim oApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim oMail As Outlook.MailItem
Dim oNameSpace As Outlook.NameSpace
Dim oFolder As MAPIFolder
Dim oItems As Outlook.Items
Dim oObj As Object
Dim ItemCount As Integer
Dim i As Integer

Set oApp = CreateObject("Outlook.Application")
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.PickFolder
Set oItems = oFolder.Items

oItems.Sort "[Received]", Ascending
ItemCount = oItems.Count

If (ItemCount = 0) Then
MsgBox "Empty Folder"


For i = 1 To ItemCount
Set oObj = oItems.Item(i)

On Error GoTo Err

Set oMail = oObj.Forward
oMail.Close olSave

Resume Next

Set oObj = Nothing
Set oMail = Nothing

MsgBox "Finished"

End If

End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question