Traversing Folders (ADO)

Topic Last Modified: 2006-06-12

Example

Visual Basic

Note

The following example uses a file URL with the Exchange OLE DB (ExOLEDB) provider. The ExOLEDB provider also supports The HTTP: URL Scheme. Using The HTTP: URL Scheme allows both client and server applications to use a single URL scheme.

'Traversing folders with ADO
'1.Create a new project in VB and Name it as project1.vbp
'2. Add a form named form1.frm
'3. Add a command button to the form name it as command1
'4. Add a list box to the form name it as list1
'5. Paste the code in the code window for the form form1
'6. Reference the project with CDO for Exchange 2000, ADO 2.5, and Active DS libraries
'7. Run the project

Private Sub Command1_Click()
Dim oRec As ADODB.Record
Dim sURL As String
Dim sSQL As String
Dim oRst As ADODB.Recordset
Dim sHREF As String
Dim sDomainName As String
Dim sLocalPath As String
Dim sMailBox As String
Dim oADSysInfo As ADSystemInfo

On Error GoTo ErrHandler


Set oADSysInfo = CreateObject("AdSystemInfo")

sDomainName = oADSysInfo.DomainDNSName
sMailBox = "User1"
'specify a URL to the mailbox
sLocalPath = "MBX/" & sMailBox

Set oRec = CreateObject("ADODB.Record")
Set oRst = CreateObject("ADODB.Recordset")

sURL = "file://./backofficestorage/" & sDomainName & "/" & sLocalPath
oRec.Open sURL
If Err.Number = 0 Then
'create the SQL query for the recordset
sSQL = "select "
sSQL = sSQL & " ""urn:schemas:mailheader:content-class"""
sSQL = sSQL & ", ""DAV:href"""
sSQL = sSQL & ", ""DAV:displayname"""
sSQL = sSQL & " from scope ('shallow traversal of " & Chr(34)
sSQL = sSQL & sURL & """') "
sSQL = sSQL & " WHERE ""DAV:ishidden"" = false"

'open the recordset, a list of folder and/or items
oRst.Open sSQL, oRec.ActiveConnection
List1.Clear
List1.AddItem "Private Folders for " & sMailBox & ":"
Do While Not oRst.EOF
List1.AddItem " " & oRst.Fields("DAV:displayname")
oRst.MoveNext
Loop
Else
MsgBox "Could not open MailBox for : " & sMailBox
End If
oRst.Close

' Now for the public folders :
oRec.Close
Set oRec.ActiveConnection = Nothing
sURL = "file://./backofficestorage/" & sDomainName & "/Public Folders"
oRec.Open sURL

'create the SQL query for the recordset
sSQL = "select "
sSQL = sSQL & " ""urn:schemas:mailheader:content-class"""
sSQL = sSQL & ", ""DAV:href"""
sSQL = sSQL & ", ""DAV:displayname"""
sSQL = sSQL & " from scope ('shallow traversal of " & Chr(34)
sSQL = sSQL & sURL & """') "
sSQL = sSQL & " WHERE ""DAV:ishidden"" = false"

'open the recordset, a list of folder and/or items
oRst.Open sSQL, oRec.ActiveConnection
List1.AddItem "Public Folders :"
Do While Not oRst.EOF
List1.AddItem " " & oRst.Fields("DAV:displayname")
oRst.MoveNext
Loop

GoTo Ending

' Implement custom error handling here.
ErrHandler:
   Debug.Print Str(Err.Number) + " " + Err.Description
   Err.Clear

Ending:

' Clean up.
oRec.Close
oRst.Close
Set oRec = Nothing
Set oRst = Nothing

End Sub