Header from Outlook Rule
Michael thanks for your help.
There was another critical error in the code as well. The inclusion of error
handling helped flush it out. The other error was a call to objSession.Logoff
The code that works for me is show below. The only problem now being the
pop-up dialog "A program is trying to access e-mail addresses you have stored
in outlook. Do you want to allow this?"
Regards Steve A
Code for retrieving internet headers in an Outlook Rule:
Function GetCDOItemFromOL(objOLItem As Object) As MAPI.Message
Dim objSession As MAPI.Session
Dim objApp As Outlook.Application
Dim strEntryID As String
Dim strStoreID As String
On Error GoTo eh
Set objApp = CreateObject("Outlook.Application")
strEntryID = objOLItem.EntryID
strStoreID = objOLItem.Parent.StoreID
Set objSession = CreateObject("MAPI.Session")
objSession.Logon , , False, False
Set GetCDOItemFromOL = objSession.GetMessage(strEntryID, strStoreID)
'objSession.Logoff == WAS AN ERROR
Set objSession = Nothing
Exit Function
eh:
If Err.Number 0 Then
MsgBox "Connection error: " & Err.Number & " " & Err.Description
Err.Clear
Exit Function
End If
End Function
Sub RuleScript(MyMail As MailItem)
Dim objCDOMsg As MAPI.Message
Dim InternetHeaders As String
Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E
Set objCDOMsg = GetCDOItemFromOL(MyMail)
InternetHeaders = objCDOMsg.Fields(CdoPR_TRANSPORT_MESSAGE_HEADERS). Value
MsgBox "Mail message arrived Internet Headers Are : " & InternetHeaders
Set objCDOMsg = Nothing
End Sub
|