Use the ADO OpenSchema Method to get table list, column list and value

Question

I am unable to get the values of the selected column in the value listbox.Please guide me my mistake.There seems to be some mistake in the private sub ListValues

Option Explicit

' The database file name.
 Private m_DBFile As String

' List the fields in this table.
 Private Sub ListFields(ByVal db_file As String, ByVal db_table_name As String)
 Dim statement As String
 Dim conn As ADODB.Connection
 Dim rs As ADODB.Recordset

' Open a connection.
Set conn = New ADODB.Connection
conn.ConnectionString = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & db_file & ";" & _
    "Persist Security Info=False"
conn.Open

lstFields.Clear

' Use OpenSchema and get the table names.
Set rs = conn.OpenSchema(adSchemaColumns, _
    Array(Empty, Empty, db_table_name))

Do While Not rs.EOF
    lstFields.AddItem rs!column_name
    rs.MoveNext
Loop

rs.Close
conn.Close
End Sub

' List the tables in the database.
Private Sub ListTables(ByVal db_name As String)
Dim statement As String
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset

' Open a connection.
Set conn = New ADODB.Connection
conn.ConnectionString = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & db_name & ";" & _
    "Persist Security Info=False"
conn.Open

lstTables.Clear
lstFields.Clear
lstValues.Clear

' Use OpenSchema and get the table names.
Set rs = conn.OpenSchema(adSchemaTables, _
    Array(Empty, Empty, Empty, "Table"))
Do While Not rs.EOF
    lstTables.AddItem rs!TABLE_NAME
    rs.MoveNext
Loop

rs.Close
conn.Close
End Sub

 Private Sub ListValues(ByVal db_file As String, ByVal db_column_name As String)
 Dim statement As String
 Dim conn As ADODB.Connection
 Dim rs As ADODB.Recordset

' Open a connection.
Set conn = New ADODB.Connection
conn.ConnectionString = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & db_file & ";" & _
    "Persist Security Info=False"
conn.Open

lstValues.Clear

' Use OpenSchema and get the Column  Value.
'Set rs = conn.OpenSchema(adSchemaColumns, _
    Array(Empty, Empty, db_table_name))
Set rs = conn.OpenSchema(adSchemaIndexes, _
Array(Empty, Empty, Empty, Empty,db_column_name))


Do While rs.EOF
    lstValues.AddItem rs!INDEX_NAME
    rs.MoveNext
Loop

rs.Close
conn.Close
End Sub
Private Sub lstTables_Click()
If lstTables.ListIndex < 0 Then Exit Sub

ListFields m_DBFile, lstTables.Text
End Sub

Private Sub lstFields_Click()
Dim db_column_name As String
If lstFields.ListIndex < 0 Then Exit Sub
db_column_name = lstFields.List(lstFields.ListIndex)

ListValues m_DBFile, lstValues.Text
End Sub

Private Sub mnudbFile_Click()
'Open existing Weight database file
cdlFiles.Flags = cdlOFNFileMustExist + cdlOFNPathMustExist
cdlFiles.Filter = "Database Files (*.mdb)|*.mdb"
cdlFiles.DialogTitle = "Open Database File"
cdlFiles.InitDir = App.Path
On Error GoTo HandleErrors
ReOpen:
cdlFiles.ShowOpen

m_DBFile = cdlFiles.FileName

'List the tables.
ListTables m_DBFile
Exit Sub
HandleErrors:
If Err.Number = cdlCancel Then Exit Sub
Select Case MsgBox(Err.Description, vbCritical + vbAbortRetryIgnore, "Error Number" + Str(Err.Number) + " in " + Err.Source)
Case vbAbort
Exit Sub
Case vbRetry
Resume ReOpen
Case vbIgnore
  Resume Next
 End Select

End Sub

Answer 1

You are missing a not statement in the ListValues method.

Do While rs.EOF 

should be

Do While Not rs.EOF 

Answer 2

Change your Code for Sub ListValues as Directed:

  Private Sub ListValues(ByVal db_file As String, ByVal db_table_name as String, ByVal        
  db_column_name As String)
  Dim statement As String
  Dim conn As ADODB.Connection
  Dim rs As ADODB.Recordset

' Open a connection

  Set conn = New ADODB.Connection
  conn.ConnectionString = _
  "Provider=Microsoft.Jet.OLEDB.4.0;" & _
  "Data Source=" & db_file & ";" & _
  "Persist Security Info=False"
  conn.Open

lstValues.Clear

Set rs = New ADODB.Recordset

rs.Open "SELECT*FROM " & db_table_name & " WHERE " & db_column_name, conn, adOpenStatic, adLockOptimistic

Do While Not rs.EOF
     lstValues.AddItem rs.Fields(db_column_name).Value
     rs.MoveNext
Loop

rs.Close
conn.Close
End Sub

Another Mistake in your coding:

Your Code:
    Set rs = conn.OpenSchema(adSchemaIndexes, _
    Array(Empty, Empty, Empty, Empty,db_column_name))

Right code:
    Set rs = conn.OpenSchema(adSchemaIndexes, _
    Array(Empty, Empty, Empty, Empty,db_table_name))