Trying to loop through RDOFolders Recursively

The code below is designed for the purpose of recursively going through all
folders in my default pst store, and all subfolders of them, so long as the
defaultmessageclass is "IPM.NOTE". The problem I have is that when the
procedure calls itself, even though I am passing an object, it is being
recast as a string the first time it is actually passed.

So, on the first iteration, all's "well" because BeginHere is missing. But
then the procedure calls itself, tries to pass rfolder [which is of type
RDOFOlder2]; and if one were thereafter to type "?TypeName(BeginHere) in the
immediate pane, the result would say "String". Hey, that's no fair!! Can
someone who has Redemption test this, and save the day??

[The test for Err.Number <>0 was added as a debugging device, since in a
perfect world there would not be any error thrown by the line:
For Each objMsg In BeginHere.Items
]

Thanks anyone!!

Option Explicit
Dim g_ObjSession

Sub Get_smtpAddresses(Optional ByRef BeginHere)
Dim rfolder ' As RDOFolder2???? Does not seem to work
Dim MyStore As RDOPstStore
Dim objMsg As Object, ObjSender As Object
Dim g_GroupOfFolders

On Error Resume Next

If IsMissing(BeginHere) Then
Set g_ObjSession = CreateObject("Redemption.RDOSession")
g_ObjSession.Logon
Set MyStore = g_ObjSession.Stores.DefaultStore
For Each rfolder In MyStore.IPMRootFolder.Folders
If rfolder.DefaultMessageClass = "IPM.Note" Then
Get_smtpAddresses (rfolder)
End If
Next
Else
Err.Clear
For Each objMsg In BeginHere.Items
If Err.Number = 0 Then 'Note, shouldn't have to!! BeginHere is the problem
Set ObjSender = objMsg.Sender
If Not ObjSender Is Nothing Then
If InStr(ObjSender.SMTPAddress, "@") > 0 Then
Debug.Print ObjSender.SMTPAddress
End If
End If
Else
Err.Clear 'Move on
End If
Next
'Done with Items, now loop through folders if any
If IsEmpty(BeginHere) Then
Exit Sub
End If
For Each rfolder In BeginHere.Folders
If IsEmpty(rfolder) Then 'Note, Shouldn't have to trap errors
Exit Sub
End If
If rfolder.DefaultMessageClass = "IPM.Note" Then
Get_smtpAddresses (rfolder)
End If
Next
End If
End Sub

Try to explicilty dim the BeginHere parameter as Object.

--
Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
-
"Bill Benson" <Bill Benson.RemoveThis@discussions.microsoft.com> wrote in message
news:9EBE6C32-4A3E-482D-A821-0FF5C21A0516@microsoft.com...
> The code below is designed for the purpose of recursively going through
> all
> folders in my default pst store, and all subfolders of them, so long as
> the
> defaultmessageclass is "IPM.NOTE". The problem I have is that when the
> procedure calls itself, even though I am passing an object, it is being
> recast as a string the first time it is actually passed.
>
> So, on the first iteration, all's "well" because BeginHere is missing. But
> then the procedure calls itself, tries to pass rfolder [which is of type
> RDOFOlder2]; and if one were thereafter to type "?TypeName(BeginHere) in
> the
> immediate pane, the result would say "String". Hey, that's no fair!! Can
> someone who has Redemption test this, and save the day??
>
> [The test for Err.Number <>0 was added as a debugging device, since in a
> perfect world there would not be any error thrown by the line:
> For Each objMsg In BeginHere.Items
> ]
>
> Thanks anyone!!
>
> Option Explicit
> Dim g_ObjSession
>
> Sub Get_smtpAddresses(Optional ByRef BeginHere)
> Dim rfolder ' As RDOFolder2???? Does not seem to work
> Dim MyStore As RDOPstStore
> Dim objMsg As Object, ObjSender As Object
> Dim g_GroupOfFolders
>
> On Error Resume Next
>
> If IsMissing(BeginHere) Then
> Set g_ObjSession = CreateObject("Redemption.RDOSession")
> g_ObjSession.Logon
> Set MyStore = g_ObjSession.Stores.DefaultStore
> For Each rfolder In MyStore.IPMRootFolder.Folders
> If rfolder.DefaultMessageClass = "IPM.Note" Then
> Get_smtpAddresses (rfolder)
> End If
> Next
> Else
> Err.Clear
> For Each objMsg In BeginHere.Items
> If Err.Number = 0 Then 'Note, shouldn't have to!! BeginHere is the
> problem
> Set ObjSender = objMsg.Sender
> If Not ObjSender Is Nothing Then
> If InStr(ObjSender.SMTPAddress, "@") > 0 Then
> Debug.Print ObjSender.SMTPAddress
> End If
> End If
> Else
> Err.Clear 'Move on
> End If
> Next
> 'Done with Items, now loop through folders if any
> If IsEmpty(BeginHere) Then
> Exit Sub
> End If
> For Each rfolder In BeginHere.Folders
> If IsEmpty(rfolder) Then 'Note, Shouldn't have to trap errors
> Exit Sub
> End If
> If rfolder.DefaultMessageClass = "IPM.Note" Then
> Get_smtpAddresses (rfolder)
> End If
> Next
> End If
> End Sub
>
>
>