martedì 3 settembre 2013

Controllo Listbox in Visual Basic 6 e associazione elementi

In questo esempio vengono caricate le categorie dal database Northwind di Microsoft su di una Listbox e a partire da una categoria selezionata si faranno vedere i prodotti associati in una seconda Listbox.
Prima di caricare questo codice nelle form di Visual Basic è necessario fare un riferimento al componente Microsoft ActiveX Data Objects 2.8 Library come mostrato nella figura successiva.
L'esempio in questo caso mostra come far visualizzare i dati all'evento Load della form per la prima Listbox, e successivamente all'evento "doppio click" o double-click per la seconda Listbox.

Option Explicit
Dim Conn As ADODB.Connection
Dim rsData As ADODB.Recordset
Dim msgError, strConDbAccess As String
Dim i As Integer

Private Sub Form_Load()

Call LoadDataFromDb

End Sub

Function LoadDataFromDb()
On Error GoTo errorDB
DoEvents

'stringa di connessione al db NWIND
strConDbAccess = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & "c:\NWIND.MDB"

Set Conn = New ADODB.Connection
With Conn
.CommandTimeout = 20
.CursorLocation = adUseClient
.Open strConDbAccess
End With

Set rsData = New ADODB.Recordset
rsData.CursorLocation = adUseServer
rsData.Open "SELECT * FROM Categories ORDER BY CategoryName;", _
Conn, adOpenKeyset, adLockOptimistic, adCmdText

'caricamento dati
For i = 0 To rsData.RecordCount - 1
List1.AddItem (rsData!CategoryName)
rsData.MoveNext
Next i

rsData.Close
Set rsData = Nothing

'chiusura db
Conn.Close
Set Conn = Nothing

Exit Function
errorDB:
msgError = "Errore DataBase" & Chr(13) & _
"Numero Errore: " & Err.Number & " Descrizione: " & Err.Description
MsgBox msgError, vbCritical + vbOKOnly
End Function


Private Sub List1_DblClick()
On Error GoTo errorDB
DoEvents
List2.Clear

Set Conn = New ADODB.Connection
With Conn
.CommandTimeout = 20
.CursorLocation = adUseClient
.Open strConDbAccess
End With

Set rsData = New ADODB.Recordset
rsData.CursorLocation = adUseServer
rsData.Open "SELECT Products.ProductName FROM Products inner join Categories " & _
"on Categories.Categoryid=Products.CategoryId where " & _
"Categories.CategoryName='" & List1.Text & "' ORDER BY ProductName;", _
Conn, adOpenKeyset, adLockOptimistic, adCmdText

'caricamento dati su seconda lista
For i = 0 To rsData.RecordCount - 1
List2.AddItem (rsData!ProductName)
rsData.MoveNext
Next i

rsData.Close
Set rsData = Nothing

'chiusura db
Conn.Close
Set Conn = Nothing

Exit Sub
errorDB:
msgError = "Errore DataBase" & Chr(13) & _
"Numero Errore: " & Err.Number & " Descrizione: " & Err.Description
MsgBox msgError, vbCritical + vbOKOnly
End Sub

Riferimento in VB6

Struttura form

Risultato