D
deko
I use VBA to loop through and inspect messages in PST folders on a local
machine and populate an Access 2003 table with messages matching various
search criteria. The problem is with encrypted messages - when the loop
tries to inspect an encrypted message, I get Error13: Type Mismatch. What I
want to do identify encrypted/digitally signed messages with code so I can
process these differently (I assume there is no way to inspect things such
as sender and recipent on encrypted/signed messages).
I found a KB article (194623) that shows how to use CDO to inspect encrypted
messages stored on an Exchange server, but how do I do this on local PST
folders? I've included code from the KB article along with my current code
below. Any help porting this for use on local PSTs is greatly appreciated!
http://support.microsoft.com/?kbid=194623
HOWTO: Use CDO (1.x) to See if a Message Is Signed and/or Encrypted
'Requires a reference to the Microsoft CDO (1.2 or 1.21) library
Dim strServer As String
Dim strMailbox As String
Dim strProfileInfo As String
Dim objSession As MAPI.Session
Dim objInbox As Folder
Dim objMessages As Messages
Dim objMessage As Message
'I am dimensioning my objects like this:
' Dim olFolder As Outlook.MAPIFolder
' Dim olmi As Outlook.MailItem
' Dim oli As Outlook.Items
' Dim olR As Outlook.Recipient
' Dim olrs As Outlook.Recipients
strServer = "MyExchangeServer" 'Insert name of an Exchange Server.
strMailbox = "MyMailbox" 'Insert the name of a Mailbox.
'Create your ProfileInfo string.
strProfileInfo = strServer & vbLf & strMailbox
'Create your session and log onto it on the fly.
Set objSession = New MAPI.Session
objSession.Logon "", "", False, True, 0, True, strProfileInfo
'I assume I do not need to create a session object for use with PSTs??
'Create your Inbox object and get all the messages in the inbox.
Set objInbox = objSession.Inbox
Set objMessages = objInbox.Messages
'Get the first message in the objMessages collection.
Set objMessage = objMessages.GetFirst
If objMessage Is Nothing Then
MsgBox "No messages to process"
Else
'Set up a loop to run through all the messages in the inbox.
Do
With objMessage
'Print the subject.
Debug.Print .Subject
'Print the Message Class.
Debug.Print .Fields(CdoPR_MESSAGE_CLASS).Value
Debug.Print
End With 'objMessage
'Get the next message.
Set objMessage = objMessages.GetNext
Loop Until objMessage Is Nothing
End If
'Here is my loop
'For Each olmi In olFolder.Items
' Set olrs = olmi.Recipients
' For Each olR In olrs 'check every recipient the message was
sent to
' If olR.Address = strE And olmi.SenderEmailAddress <>
olR.Address Then
' Call AddMatchSent(rsts, olmi, strE)
' End If
' Next
' 'check sender address
' If strFn <> "Sent Items" And olmi.SenderEmailAddress = strE
Then
' Call AddMatchRecd(rstr, olmi, strE)
' intRct = intRct + 1
' End If
' Next olmi
machine and populate an Access 2003 table with messages matching various
search criteria. The problem is with encrypted messages - when the loop
tries to inspect an encrypted message, I get Error13: Type Mismatch. What I
want to do identify encrypted/digitally signed messages with code so I can
process these differently (I assume there is no way to inspect things such
as sender and recipent on encrypted/signed messages).
I found a KB article (194623) that shows how to use CDO to inspect encrypted
messages stored on an Exchange server, but how do I do this on local PST
folders? I've included code from the KB article along with my current code
below. Any help porting this for use on local PSTs is greatly appreciated!
http://support.microsoft.com/?kbid=194623
HOWTO: Use CDO (1.x) to See if a Message Is Signed and/or Encrypted
'Requires a reference to the Microsoft CDO (1.2 or 1.21) library
Dim strServer As String
Dim strMailbox As String
Dim strProfileInfo As String
Dim objSession As MAPI.Session
Dim objInbox As Folder
Dim objMessages As Messages
Dim objMessage As Message
'I am dimensioning my objects like this:
' Dim olFolder As Outlook.MAPIFolder
' Dim olmi As Outlook.MailItem
' Dim oli As Outlook.Items
' Dim olR As Outlook.Recipient
' Dim olrs As Outlook.Recipients
strServer = "MyExchangeServer" 'Insert name of an Exchange Server.
strMailbox = "MyMailbox" 'Insert the name of a Mailbox.
'Create your ProfileInfo string.
strProfileInfo = strServer & vbLf & strMailbox
'Create your session and log onto it on the fly.
Set objSession = New MAPI.Session
objSession.Logon "", "", False, True, 0, True, strProfileInfo
'I assume I do not need to create a session object for use with PSTs??
'Create your Inbox object and get all the messages in the inbox.
Set objInbox = objSession.Inbox
Set objMessages = objInbox.Messages
'Get the first message in the objMessages collection.
Set objMessage = objMessages.GetFirst
If objMessage Is Nothing Then
MsgBox "No messages to process"
Else
'Set up a loop to run through all the messages in the inbox.
Do
With objMessage
'Print the subject.
Debug.Print .Subject
'Print the Message Class.
Debug.Print .Fields(CdoPR_MESSAGE_CLASS).Value
Debug.Print
End With 'objMessage
'Get the next message.
Set objMessage = objMessages.GetNext
Loop Until objMessage Is Nothing
End If
'Here is my loop
'For Each olmi In olFolder.Items
' Set olrs = olmi.Recipients
' For Each olR In olrs 'check every recipient the message was
sent to
' If olR.Address = strE And olmi.SenderEmailAddress <>
olR.Address Then
' Call AddMatchSent(rsts, olmi, strE)
' End If
' Next
' 'check sender address
' If strFn <> "Sent Items" And olmi.SenderEmailAddress = strE
Then
' Call AddMatchRecd(rstr, olmi, strE)
' intRct = intRct + 1
' End If
' Next olmi