HOWTO: Use ODBC API SQLTables Function with Visual Basic and RDO

      Dim cn As New rdoConnection

         Private Sub Form_Load()
           'establish rdoConnection to use hDbc for SQLTables

           'SQL Server example
           'cn.Connect = _
           '  "Driver={SQL Server}; Server=MyServer; " & _
           '  "Database=Pubs; " & _
           '  "Uid=sa; Pwd="

           'Oracle example
           cn.Connect = _
             "Driver={Microsoft ODBC Driver for Oracle}; " & _
             "connectstring=dsenterprise.world; " & _
             "Uid=demo; Pwd=demo"
           cn.EstablishConnection
         End Sub

         Private Sub Command1_Click()
           Dim sngT As Single, intN As Integer

           'Get tables using ODBC API
           List1.Clear
           intN = 0
           sngT = Timer
           aTables = GetODBCTables(hDbc:=cn.hDbc, Owner:=True, _
             TableType:="'TABLE', 'VIEW'")
           Dim i As Integer
           For i = 0 To UBound(aTables) - 1
             List1.AddItem aTables(i)
             intN = intN + 1
           Next i
           Debug.Print intN, "odbc tables: ", Timer - sngT

           DoEvents

           'Get tables using rdoTables collection
           List2.Clear
           intN = 0
           sngT = Timer
           intN = cn.rdoTables.Count
           For i = 0 To intN - 1
             List2.AddItem cn.rdoTables(i).Name
           Next i
           Debug.Print intN, "rdo tables: ", Timer - sngT
         End Sub

         Public Function GetODBCTables(ByVal hDbc As Long, _
           Optional Owner = True, _
           Optional TableType = "'TABLE', 'VIEW', 'SYSTEM TABLE'") _
           As Variant

           On Error GoTo ehGetDSNTables
           Dim intHstmt As Long, intRc As Integer
           Dim strErrMsg As String * SQL_MAX_MESSAGE_LENGTH
           Dim strSqlState As String * 5
           Dim arrTables() As Variant, intCounter As Integer
           Dim strTable As String
           Dim strName As String * 255, strOwner As String * 255
           Dim lngLenRead As Long


           intRc = SQLAllocStmt(ByVal hDbc, intHstmt)
           intRc = SQLTables(ByVal intHstmt, ByVal 0&, SQL_NTS, _
             ByVal 0&, SQL_NTS, ByVal 0&, SQL_NTS, _
             ByVal CStr(TableType), Len(TableType))
           If intRc <> SQL_SUCCESS Then
             GoTo ehGetDSNTables
           End If

           strOwner = String(255, 0)       'Init string to hold data.
           strName = String(255, 0)        'Init string to hold data.

           intRc = SQLFetch(intHstmt)
           If intRc <> SQL_SUCCESS Then
             GoTo ehGetDSNTables
           End If

           intCounter = 0
           ReDim Preserve arrTables(intCounter)
           While intRc <> SQL_NO_DATA_FOUND
             intRc = SQLGetData(ByVal intHstmt, 2, SQL_C_CHAR, _
               ByVal strOwner, 254, lngLenRead)
             intRc = SQLGetData(ByVal intHstmt, 3, SQL_C_CHAR, _
               ByVal strName, 254, lngLenRead)
             strTable = IIf(Owner, Mid(strOwner, 1, _
               InStr(strOwner, Chr(0)) - 1) & ".", "")
             strTable = strTable & Mid(strName, 1, _
               InStr(strName, Chr(0)) - 1)
             ReDim Preserve arrTables(intCounter)
             arrTables(intCounter) = strTable
             intCounter = intCounter + 1

             strOwner = String(255, 0)    'Init string to hold data.
             strName = String(255, 0)     'Init string to hold data.
             intRc = SQLFetch(intHstmt)
           Wend
           intRc = SQLFreeStmt(ByVal intHstmt, SQL_CLOSE)

           GetODBCTables = arrTables
           Exit Function
         ehGetDSNTables:
           intRc = SQLError(ByVal henv, ByVal hDbc, _
             ByVal intHstmt, strSqlState, 0, strErrMsg, _
             SQL_MAX_MESSAGE_LENGTH, 0)
           Debug.Print "(" & strSqlState & ")" & strErrMsg
         End Function