Attribute VB_Name = "dtHier"
'----------------------------------------------------------------------------
'
' (c) Copyright IBM Corp. 2007 All rights reserved.
' 
' The following sample of source code ("Sample") is owned by International 
' Business Machines Corporation or one of its subsidiaries ("IBM") and is 
' copyrighted and licensed, not sold. You may use, copy, modify, and 
' distribute the Sample in any form without payment to IBM, for the purpose of 
' assisting you in the development of your applications.
' 
' The Sample code is provided to you on an "AS IS" basis, without warranty of 
' any kind. IBM HEREBY EXPRESSLY DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR 
' IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
' MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. Some jurisdictions do 
' not allow for the exclusion or limitation of implied warranties, so the above 
' limitations or exclusions may not apply to you. IBM shall not be liable for 
' any damages you suffer as a result of using, copying, modifying or 
' distributing the Sample, even if IBM has been advised of the possibility of 
' such damages.
'----------------------------------------------------------------------------
'
' SOURCE FILE NAME: dtHier.bas
'
' SAMPLE: Retrieve hierarchical data
'
' FORMS USED:
'         frmMain (Demo.frm)
'
'----------------------------------------------------------------------------
'
' For more information on the sample programs, see the README file.
'
' For information on building ADO applications with Visual Basic, 
' see the Developing ADO.NET and OLE DB Applications book.
'
' For information on using SQL statements, see the SQL Reference.
'
' For the latest information on programming, compiling, and running DB2
' applications, visit the DB2 Information Center:
'     http://publib.boulder.ibm.com/infocenter/db2luw/v9r7/index.jsp
'----------------------------------------------------------------------------

Option Explicit

'This procedure executes shaped SQL statements and returns a recordset
'with hierarchical cursors.
Public Function ExecuteHSQL(strMsg As String, _
                            con As ADODB.Connection) _
  As ADODB.Recordset
  
  Dim rst As ADODB.Recordset
  Dim strShape As String

  'create a Shape command.
  strShape = "SHAPE {SELECT projno,projname,prstdate,prendate " & _
             "FROM project} As Project " & _
             "APPEND ({SELECT * FROM emp_act} AS Activity " & _
             "RELATE projno TO projno)"

  'define the error handler
  On Error GoTo ExecuteHSQL_Error

  'open a recordset object
  Set rst = New ADODB.Recordset
  rst.StayInSync = False
  rst.Open strShape, con

  'get recordCount and return recordset
  rst.MoveLast
  strMsg = rst.RecordCount & " record(s) selected from first level"
  Set ExecuteHSQL = rst

ExecuteHSQL_Exit:
  Set rst = Nothing
  Exit Function
   
ExecuteHSQL_Error:
  strMsg = "ERROR: " & Err.Description
  Resume ExecuteHSQL_Exit

End Function