Getting Email Headers in Outlook
-
I've been trying to obtain the email header from messages in Outlook using VBA. I have done some investigation and found that in outlook they are stored separately and require use of the CDO library to get hold of the header. So, I used Tools-Reference to enable the CDO Win 2000 library, cdosys.dll and employed the code below - but on compiling in the Outlook VBA Editor it gives me errors in all references to that CDO library. Can anyone assist here? Many thanks ;)
Public Function InternetHeaders() As String Dim objOutlook As Outlook.Application Dim objItem As Outlook.MailItem Dim objCDO As MAPI.Session Dim objMessage As MAPI.Message Dim objFields As MAPI.Fields Dim strID As String Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E On Error Resume Next ' Instantiate an Outlook Application object. Set objOutlook = CreateObject("Outlook.Application") 'Find the current email item and get its EntryID Set objItem = objOutlook.ActiveInspector.CurrentItem strID = objItem.EntryID 'Then set up a CDO Session using a piggy-back login Set objCDO = CreateObject("MAPI.Session") objCDO.Logon "", "", False, False 'Now get the item as a CDO Message Set objMessage = objCDO.GetMessage(strID) 'Now get the headers from the message Set objFields = objMessage.Fields InternetHeaders = objFields.Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value 'Now that the headers are captured in a string you can do whatever you want with them objCDO.Logoff Set objFields = Nothing Set objMessage = Nothing Set objCDO = Nothing Set objItem = Nothing Set objOutlook = Nothing End Functionu6ik
-
I've been trying to obtain the email header from messages in Outlook using VBA. I have done some investigation and found that in outlook they are stored separately and require use of the CDO library to get hold of the header. So, I used Tools-Reference to enable the CDO Win 2000 library, cdosys.dll and employed the code below - but on compiling in the Outlook VBA Editor it gives me errors in all references to that CDO library. Can anyone assist here? Many thanks ;)
Public Function InternetHeaders() As String Dim objOutlook As Outlook.Application Dim objItem As Outlook.MailItem Dim objCDO As MAPI.Session Dim objMessage As MAPI.Message Dim objFields As MAPI.Fields Dim strID As String Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E On Error Resume Next ' Instantiate an Outlook Application object. Set objOutlook = CreateObject("Outlook.Application") 'Find the current email item and get its EntryID Set objItem = objOutlook.ActiveInspector.CurrentItem strID = objItem.EntryID 'Then set up a CDO Session using a piggy-back login Set objCDO = CreateObject("MAPI.Session") objCDO.Logon "", "", False, False 'Now get the item as a CDO Message Set objMessage = objCDO.GetMessage(strID) 'Now get the headers from the message Set objFields = objMessage.Fields InternetHeaders = objFields.Item(CdoPR_TRANSPORT_MESSAGE_HEADERS).Value 'Now that the headers are captured in a string you can do whatever you want with them objCDO.Logoff Set objFields = Nothing Set objMessage = Nothing Set objCDO = Nothing Set objItem = Nothing Set objOutlook = Nothing End Functionu6ik
-
Okay. It looks like the issue is that in Outlook VBA with the CDO library referenced, I get the error 'Activex component can't create object'. The line that fails is: Set CDOSession = CreateObject("MAPI.Session") Any ideas?
u6ik