Thursday, June 17, 2004

Public folder RSS Feed Event sink

I've gone a bit RSS mad of late for today's edition I created an Event sink for public folders so when a new mail or post arrives into that folder it will fire a script that updates a feed with the last 7 days of posts. I guess the cool thing here is you can stick this on all the important public folders in your org and then use one web page to aggregate across all the feeds and present this back to the user as one single web page. Also it lets people subscribe to folders and receive notification of updates etc.

Sub ExStoreEvents_OnSave(pEventInfo, bstrURLItem, lFlags)

on error resume next
set DispEvtInfo = pEventInfo
set ADODBRec = DispEvtInfo.EventRecord
set objdom = CreateObject("MICROSOFT.XMLDOM")
Set objField = objDom.createElement("rss")
Set objattID = objDom.createAttribute("version")
objattID.Text = "2.0"
objField.setAttributeNode objattID
objDom.appendChild objField
Set objField1 = objDom.createElement("channel")
objfield.appendChild objField1
Set objField3 = objDom.createElement("title")
objfield3.text = "Public Folder Feed"
objfield1.appendChild objField3
Set objField4 = objDom.createElement("link")
objfield1.appendChild objField4
Set objField5 = objDom.createElement("description")
objfield5.text = "Public Folder Feed For Path"
objfield1.appendChild objField5
Set objField6 = objDom.createElement("language")
objfield6.text = "en-us"
objfield1.appendChild objField6
Set objField7 = objDom.createElement("lastBuildDate")
objfield7.text = formatdatetime(now(),1) & " " & formatdatetime(now(),4) & ":00 GMT"
objfield1.appendChild objField7
Set Rs = CreateObject("ADODB.Recordset")
Set fso = CreateObject("Scripting.FileSystemObject")
Set msgobj = CreateObject("CDO.Message")
tyear = year(now()-7)
tmonth = month(now()-7)
if tmonth < 10 then tmonth = 0 & tmonth
stday = day(now()-7)
if stday < 10 then stday = 0 & stday
sttime = formatdatetime(now1,4)
qdatest = tyear & "-" & tmonth & "-" & stday & "T"
qdatest1 = qdatest & sttime & ":" & "00Z"
set Rec = CreateObject("ADODB.Record")
set Rec1 = CreateObject("ADODB.Record")
Set Conn = CreateObject("ADODB.Connection")
mailboxurl = ADODBRec.fields("Dav:parentname")
Conn.Provider = "ExOLEDB.DataSource"
Rec.Open mailboxurl, ,3
SSql = "SELECT ""DAV:href"", ""DAV:contentclass"", ""urn:schemas:httpmail:textdescription"", ""urn:schemas:httpmail:datereceived"", "
SSql = SSql & """urn:schemas:httpmail:fromemail"", ""urn:schemas:httpmail:subject"", ""DAV:ishidden"" "
Ssql = SSql & " FROM scope('shallow traversal of """ & mailboxurl & """') "
SSql = SSql & " WHERE (""urn:schemas:httpmail:datereceived"" > CAST(""" & qdatest1 & """ as 'dateTime')) AND ""DAV:isfolder"" = false"
Rs.CursorLocation = 3 'adUseServer = 2, adUseClient = 3
Rs.CursorType = 3 SSql, rec.ActiveConnection, 3
if Rs.recordcount <> 0 then
while not rs.eof
if rs.fields("DAV:ishidden") = 0 then
Set objField2 = objDom.createElement("item")
objfield1.appendChild objField2
Set objField8 = objDom.createElement("title")
objfield8.text = rs.fields("urn:schemas:httpmail:subject")
objfield2.appendChild objField8
Set objField9 = objDom.createElement("link")
objfield9.text = "http://mgnms01/public" _
& right(Rs.fields("Dav:href"),(len(Rs.fields("Dav:href"))-instr(Rs.fields("Dav:href"),"/Public Folders/"))-14)
objfield2.appendChild objField9
Set objField10 = objDom.createElement("description")
objfield10.text = Rs.fields("urn:schemas:httpmail:textdescription")
objfield2.appendChild objField10
Set objField11 = objDom.createElement("author")
objfield11.text = rs.fields("urn:schemas:httpmail:fromemail")
objfield2.appendChild objField11
Set objField12 = objDom.createElement("pubDate")
objfield12.text = formatdatetime(rs.fields("urn:schemas:httpmail:datereceived"),1) _
& " " & formatdatetime(rs.fields("urn:schemas:httpmail:datereceived"),4) & ":00 GMT"
objfield2.appendChild objField12
set objfield2 = nothing
set objfield8 = nothing
set objfield9 = nothing
set objfield10 = nothing
set objfield11 = nothing
end if
end if
Set objPI = objDom.createProcessingInstruction("xml", "version='1.0'")
objDom.insertBefore objPI, objDom.childNodes(0)"d:\inetpub\wwwroot\pubfolder1.xml")

End Sub


Anonymous said...

Very cool! I will try it out.

Anonymous said...

This could come in handy - thanks.

Colin Walker

Anonymous said...

Any hints (step by step) on how to make a use of it? I'm not a developer and would like to use it :-)

Glen said...

Be carefull when cutting and pasting this script from the blog as you may find some lines overflow (onto the next line) and you'll have compile errors.

To get VBS event sinks going on a Exchange 2003/2000
server you first need to register the script host sink
have a look at . The procedure is the same under 2003. This installs a COM+ object which essentially hosts the VBS script you are going to use. There's is a lot of good documentation in the Exchange SDK (which you can download from ) around using Event sinks. I've also written several articles about using the VBS Event sink on Exchange have a look at.

Anonymous said...


I would really really appreciate an installer for this script, and an example of how to use it.


Anonymous said...


I don't get the script running. Is the a tutorial some where?


Glen said...

no see the comments above that link to some artilcles that should help geting started with event sinks. Once you have got your head around how sinks work you can then have a go at this one.