A
Andy Smith
LOTS of people have been asking about how to get full internet headers
from a message, and I finally got it to work by examining stuff and
links in the program_VBA group -- thanks, everyone!
To use this in VBA, make sure in Tools / References that "Microsoft CDO x.xx
Library" is checked so you get the "MAPI" library. Then just paste
this code in any Outlook VBA module.
Note that after the first call to FullHdrs$, MS, the MAPI session, is
active as *any* code runs, because it is never logged off. So you
might want to put "Public MS As MAPI.Session" outside all procedures
to use it in other code, because as written here only FullHdrs$ can
see it.
----------------------------------------------------------------------------
Public Function FullHdrs$(MI As MailItem)
Static MS As New MAPI.Session ' Maintain to suppress prompts
Dim CU$ ' Current user
Dim MM As MAPI.Message ' MAPI message, has headers
On Error GoTo MS_LOGON ' Test if session logged on by
CU$ = MS.CurrentUser ' trying to access its user
GoTo MS_LOGGED_ON ' Yes, skip logon
MS_LOGON: ' No, use default profile, this
MS.Logon , , False, False ' session, no dialog for at
Resume MS_LOGGED_ON ' most one security prompt
MS_LOGGED_ON: ' Resume normal error handing
On Error Goto 0
' Use Outlook ID to get MAPI msg
Set MM = MS.GetMessage(MI.EntryID)
' MAPI msg has the full headers
FullHdrs$ = MM.Fields(CdoPR_TRANSPORT_MESSAGE_HEADERS)
End Function
from a message, and I finally got it to work by examining stuff and
links in the program_VBA group -- thanks, everyone!
To use this in VBA, make sure in Tools / References that "Microsoft CDO x.xx
Library" is checked so you get the "MAPI" library. Then just paste
this code in any Outlook VBA module.
Note that after the first call to FullHdrs$, MS, the MAPI session, is
active as *any* code runs, because it is never logged off. So you
might want to put "Public MS As MAPI.Session" outside all procedures
to use it in other code, because as written here only FullHdrs$ can
see it.
----------------------------------------------------------------------------
Public Function FullHdrs$(MI As MailItem)
Static MS As New MAPI.Session ' Maintain to suppress prompts
Dim CU$ ' Current user
Dim MM As MAPI.Message ' MAPI message, has headers
On Error GoTo MS_LOGON ' Test if session logged on by
CU$ = MS.CurrentUser ' trying to access its user
GoTo MS_LOGGED_ON ' Yes, skip logon
MS_LOGON: ' No, use default profile, this
MS.Logon , , False, False ' session, no dialog for at
Resume MS_LOGGED_ON ' most one security prompt
MS_LOGGED_ON: ' Resume normal error handing
On Error Goto 0
' Use Outlook ID to get MAPI msg
Set MM = MS.GetMessage(MI.EntryID)
' MAPI msg has the full headers
FullHdrs$ = MM.Fields(CdoPR_TRANSPORT_MESSAGE_HEADERS)
End Function