Outlook Banter

Outlook Banter (http://www.outlookbanter.com/)
-   Outlook and VBA (http://www.outlookbanter.com/outlook-vba/)
-   -   Add Xheader to Received Message (http://www.outlookbanter.com/outlook-vba/61093-add-xheader-received-message.html)

shubhangi November 13th 07 02:02 PM

Add Xheader to Received Message
 
hello!
I need to monitor Inbox Items,if the item contains Xheader or not.I have one
command button
"save" on Read Msg Window form region.If the msg contains Xheader(say
x-matter) then
modify it with whatever value supplied by user,if the msg doesn't contain
Xheader then add xheader to that msg(x-matter) with value supplied by
user.I've Below code,it works if the
msg already has Xheader(x-matter) but not if the msg doesn't have
xheader(x-matter)

Dim PR_TRANSPORT_MESSAGE_HEADERS As String = &H7D001E
Dim strOldAllXheaderValue, strNewAllXheaderValue,
strOldXheaderValue, strNewXheaderValue As String
Dim iStartLoc, iEndLoc As Integer
sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = MailItem


strOldAllXheaderValue =
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS)
strNewAllXheaderValue = strOldAllXheaderValue

iStartLoc = InStr(strOldAllXheaderValue, "x-matter",
CompareMethod.Text)
If iStartLoc 0 Then strOldXheaderValue =
Mid(strOldAllXheaderValue, iStartLoc)
iEndLoc = InStr(strOldXheaderValue, gblSeparator)
'gblSeparator is ";;;"
AddTrace("EndLoc:" & iEndLoc)
If iStartLoc 0 And iEndLoc 0 Then
strOldXheaderValue = Left(strOldXheaderValue, iEndLoc -
1)
strNewXheaderValue = "x-matter: " & CtlRegion.Matter
'user supplied value for xheader
strNewAllXheaderValue =
strOldAllXheaderValue.Replace(strOldXheaderValue, strNewXheaderValue)
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS) =
strNewAllXheaderValue
sItem.Save()
AddTrace("Update to x-matter string done")
Else
Tag =
sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}", "X-Matter")
Tag = Tag Or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = CtlRegion.Matter & gblSeparator
'CtlRegion.Matter is user supplied value for xheader
'gblSeparator is ";;;"
sItem.Subject = sItem.Subject 'to trick Outlook into
thinking that something has changed
sItem.Save()
AddTrace("Added Xheader x-matter")
End If

Thanks



Dmitry Streblechenko November 13th 07 05:18 PM

Add Xheader to Received Message
 
Do you get any errors?
Do you get the expected value from GetIDsFromNames?
Outlook might not see your changes, try to add the following line before you
call sItem.Save

MailItem.Subject = MailItem.Subject

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"shubhangi" wrote in message
...
hello!
I need to monitor Inbox Items,if the item contains Xheader or not.I have
one command button
"save" on Read Msg Window form region.If the msg contains Xheader(say
x-matter) then
modify it with whatever value supplied by user,if the msg doesn't contain
Xheader then add xheader to that msg(x-matter) with value supplied by
user.I've Below code,it works if the
msg already has Xheader(x-matter) but not if the msg doesn't have
xheader(x-matter)

Dim PR_TRANSPORT_MESSAGE_HEADERS As String = &H7D001E
Dim strOldAllXheaderValue, strNewAllXheaderValue,
strOldXheaderValue, strNewXheaderValue As String
Dim iStartLoc, iEndLoc As Integer
sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = MailItem


strOldAllXheaderValue =
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS)
strNewAllXheaderValue = strOldAllXheaderValue

iStartLoc = InStr(strOldAllXheaderValue, "x-matter",
CompareMethod.Text)
If iStartLoc 0 Then strOldXheaderValue =
Mid(strOldAllXheaderValue, iStartLoc)
iEndLoc = InStr(strOldXheaderValue, gblSeparator)
'gblSeparator is ";;;"
AddTrace("EndLoc:" & iEndLoc)
If iStartLoc 0 And iEndLoc 0 Then
strOldXheaderValue = Left(strOldXheaderValue, iEndLoc -
1)
strNewXheaderValue = "x-matter: " & CtlRegion.Matter
'user supplied value for xheader
strNewAllXheaderValue =
strOldAllXheaderValue.Replace(strOldXheaderValue, strNewXheaderValue)
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS) =
strNewAllXheaderValue
sItem.Save()
AddTrace("Update to x-matter string done")
Else
Tag =
sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}",
"X-Matter")
Tag = Tag Or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = CtlRegion.Matter & gblSeparator
'CtlRegion.Matter is user supplied value for xheader
'gblSeparator is ";;;"
sItem.Subject = sItem.Subject 'to trick Outlook into
thinking that something has changed
sItem.Save()
AddTrace("Added Xheader x-matter")
End If

Thanks




shubhangi November 14th 07 11:31 AM

Add Xheader to Received Message
 
Thanks for reply!
No I don't get any error.I can see expected xheader value with
GetIDsFromNames.
But When I dump "PR_TRANSPORT_MESSAGE_HEADERS" ,I could not see my xheader
there.I also added before sItem.Save.But Invain!
MailItem.Subject = MailItem.Subject before
Thanks again

"Dmitry Streblechenko" wrote in message
...
Do you get any errors?
Do you get the expected value from GetIDsFromNames?
Outlook might not see your changes, try to add the following line before
you call sItem.Save

MailItem.Subject = MailItem.Subject

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"shubhangi" wrote in message
...
hello!
I need to monitor Inbox Items,if the item contains Xheader or not.I have
one command button
"save" on Read Msg Window form region.If the msg contains Xheader(say
x-matter) then
modify it with whatever value supplied by user,if the msg doesn't contain
Xheader then add xheader to that msg(x-matter) with value supplied by
user.I've Below code,it works if the
msg already has Xheader(x-matter) but not if the msg doesn't have
xheader(x-matter)

Dim PR_TRANSPORT_MESSAGE_HEADERS As String = &H7D001E
Dim strOldAllXheaderValue, strNewAllXheaderValue,
strOldXheaderValue, strNewXheaderValue As String
Dim iStartLoc, iEndLoc As Integer
sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = MailItem


strOldAllXheaderValue =
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS)
strNewAllXheaderValue = strOldAllXheaderValue

iStartLoc = InStr(strOldAllXheaderValue, "x-matter",
CompareMethod.Text)
If iStartLoc 0 Then strOldXheaderValue =
Mid(strOldAllXheaderValue, iStartLoc)
iEndLoc = InStr(strOldXheaderValue, gblSeparator)
'gblSeparator is ";;;"
AddTrace("EndLoc:" & iEndLoc)
If iStartLoc 0 And iEndLoc 0 Then
strOldXheaderValue = Left(strOldXheaderValue,
iEndLoc - 1)
strNewXheaderValue = "x-matter: " & CtlRegion.Matter
'user supplied value for xheader
strNewAllXheaderValue =
strOldAllXheaderValue.Replace(strOldXheaderValue, strNewXheaderValue)
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS) =
strNewAllXheaderValue
sItem.Save()
AddTrace("Update to x-matter string done")
Else
Tag =
sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}",
"X-Matter")
Tag = Tag Or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = CtlRegion.Matter & gblSeparator
'CtlRegion.Matter is user supplied value for xheader
'gblSeparator is ";;;"
sItem.Subject = sItem.Subject 'to trick Outlook into
thinking that something has changed
sItem.Save()
AddTrace("Added Xheader x-matter")
End If

Thanks






Dmitry Streblechenko November 14th 07 06:49 PM

Add Xheader to Received Message
 
Your custom header will not be automatically added to
PR_TRANSPORT_MESSAGE_HEADERS. Why do you expect that to happen?
It is your responsibily to modiy PR_TRANSPORT_MESSAGE_HEADERS explicitly for
a received message.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"shubhangi" wrote in message
...
Thanks for reply!
No I don't get any error.I can see expected xheader value with
GetIDsFromNames.
But When I dump "PR_TRANSPORT_MESSAGE_HEADERS" ,I could not see my xheader
there.I also added before sItem.Save.But Invain!
MailItem.Subject = MailItem.Subject before
Thanks again

"Dmitry Streblechenko" wrote in message
...
Do you get any errors?
Do you get the expected value from GetIDsFromNames?
Outlook might not see your changes, try to add the following line before
you call sItem.Save

MailItem.Subject = MailItem.Subject

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool

"shubhangi" wrote in message
...
hello!
I need to monitor Inbox Items,if the item contains Xheader or not.I have
one command button
"save" on Read Msg Window form region.If the msg contains Xheader(say
x-matter) then
modify it with whatever value supplied by user,if the msg doesn't
contain Xheader then add xheader to that msg(x-matter) with value
supplied by user.I've Below code,it works if the
msg already has Xheader(x-matter) but not if the msg doesn't have
xheader(x-matter)

Dim PR_TRANSPORT_MESSAGE_HEADERS As String = &H7D001E
Dim strOldAllXheaderValue, strNewAllXheaderValue,
strOldXheaderValue, strNewXheaderValue As String
Dim iStartLoc, iEndLoc As Integer
sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = MailItem


strOldAllXheaderValue =
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS)
strNewAllXheaderValue = strOldAllXheaderValue

iStartLoc = InStr(strOldAllXheaderValue, "x-matter",
CompareMethod.Text)
If iStartLoc 0 Then strOldXheaderValue =
Mid(strOldAllXheaderValue, iStartLoc)
iEndLoc = InStr(strOldXheaderValue, gblSeparator)
'gblSeparator is ";;;"
AddTrace("EndLoc:" & iEndLoc)
If iStartLoc 0 And iEndLoc 0 Then
strOldXheaderValue = Left(strOldXheaderValue,
iEndLoc - 1)
strNewXheaderValue = "x-matter: " & CtlRegion.Matter
'user supplied value for xheader
strNewAllXheaderValue =
strOldAllXheaderValue.Replace(strOldXheaderValue, strNewXheaderValue)
sItem.Fields(PR_TRANSPORT_MESSAGE_HEADERS) =
strNewAllXheaderValue
sItem.Save()
AddTrace("Update to x-matter string done")
Else
Tag =
sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}",
"X-Matter")
Tag = Tag Or &H1E 'the type is PT_STRING8
sItem.Fields(Tag) = CtlRegion.Matter & gblSeparator
'CtlRegion.Matter is user supplied value for xheader
'gblSeparator is ";;;"
sItem.Subject = sItem.Subject 'to trick Outlook into
thinking that something has changed
sItem.Save()
AddTrace("Added Xheader x-matter")
End If

Thanks









All times are GMT +1. The time now is 01:03 PM.

Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ©2004-2006 OutlookBanter.com