Utilisez la méthode ADO OpenSchema pour obtenir la liste des tables, la liste des colonnes et la valeur

Question

Je ne parviens pas à obtenir les valeurs de la colonne sélectionnée dans la liste de valeurs.Veuillez me guider dans mon erreur.Il semble y avoir une erreur dans le sous-listeValeurs privées

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

Il vous manque une instruction not dans la méthode ListValues.

Do While rs.EOF 

devrait être

Do While Not rs.EOF 

Answer 2

changer votre code pour les sous ListValues ​​comme Mise en scène:

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 

'ouvrir une connexion

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 

Une autre erreur dans votre codage:

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))