CDO: Accessing message in Exchange Public Folder

[davidiwharper]

Hello all

I am trying to modify a CDO script that moves email messages out of a user's inbox and into a drop folder. I want to update it to use a Public Folder instead.

The portion of the original script that matters is:

' URL used for Outlook Web Access
strOWAURL = "http://servername/exchange/"
 
' Login
 
Set objUserSess = CreateObject("MAPI.Session")
objUserSess.Logon  , , , , , , strServerName & vbLF & strAccountName
 
' Move each message
 
Set objFolder = objUserSess.Inbox
For each objMsg in objFolder.Messages
    for each strMsgField in objMsg.fields
        if instr(strMsgField,"/Inbox/") > 0 then
            set objWebMsg = createobject("CDO.Message") 
            objWebMsg.datasource.open strOWAURL& strMailBoxName  & strMsgField
            set stm = objWebMsg.getstream() 
            stm.type = 2
            stm.Charset = "x-ansi"
            rfcmsg = stm.readtext
            rfcmsg = "x-sender: " & objWebMsg.fields("urn:schemas:httpmail:from") & vbcrlf & rfcmsg
            rfcmsg = "x-receiver: " &strListEmail & vbcrlf & rfcmsg
            stm.position = 0 
            stm.writetext = rfcmsg
            stm.savetofile strPickupFolder & objMsg.ID  & ".eml"
        end if
    next
    objMsg.Delete
next
 

My modified script is:

' URL used for Outlook Web Access
strOWAURL = "http://localhost/public/testfolder/"
 
Set objSession = CreateObject("MAPI.Session")
objSession.Logon  , , , , , , strServerName & vbLF & strAccountName
 
' Change from a user inbox to the Public Folder infostore
 
Set objInfoStores = objSession.InfoStores
Set objInfoStore = objInfoStores.Item("Public Folders")
Set objRootFold = objInfoStore.RootFolder
 
Set objFolder = objRootFold.Folders(2).Folders("TestFolder")
 
For each objMsg in objFolder.Messages
    for each strMsgField in objMsg.fields
 
            ' deleted line if instr(strMsgField,"/Inbox/") > 0 then
            ' couldn't see the relevance in a Public Folder
            ' with no subfolders
 
            set objWebMsg = createobject("CDO.Message") 
 
            ' this is the line that doesn't work below
            ' the error is that it can't find the message
 
            objWebMsg.datasource.open strOWAURL & strMsgField
 

So my question is, how can I open the message with the datasource.open method, given that we are now talking about a message object in a public folder, not a user's inbox?

I'm totally new to VB, so if I have made some outrageous and/or idiotic error, then I am not surprised (and I apologise in advance!).

Thanks for your help.