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"
Else
For i = 1 To ItemCount
Set oObj = oItems.Item(i)
On Error GoTo Err
Set oMail = oObj.Forward
oMail.Save
oMail.Close olSave
Err:
Resume Next
Set oObj = Nothing
Set oMail = Nothing
Next
MsgBox "Finished"
End If
End Sub
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"
Else
For i = 1 To ItemCount
Set oObj = oItems.Item(i)
On Error GoTo Err
Set oMail = oObj.Forward
oMail.Save
oMail.Close olSave
Err:
Resume Next
Set oObj = Nothing
Set oMail = Nothing
Next
MsgBox "Finished"
End If
End Sub