Sección de códigos , trucos y ejemplos para visual basic

358 - Cargar recordset Ado en Combobox y Listbox

Ejemplo para cargar los registros de un campo de un recordset Ado en un control combobox o en un Listbox

Este ejemplo, en ves de utilizar la propiedad AddIetm para añadir los registros a dichos controles, utiliza la función del api SendMesage y también la función LockWindowUpdate, para que la carga de los mismos sea mas rápida

Formulario

vista del formulario con los controles combo y listbox para el ejemplo de visual basic

El código fuente tiene una función llamada "cargar" con los siguietnes parámetros:

Public Function Cargar(ElControl As Object, _
                       rst As ADODB.Recordset, _
                       Columna As String) As Boolean

El parámetro "ElControl as Object" , es el control ListBox o comboBox

El parámetro rst, es un recordset ado que ya contiene los registros cargados.

Columna, es el nombre del campo a cargar

por ejemplo

Call Cargar (Combo1, Rst, "Clientes")

Controles y referencias

Agregar la referencia a Microsoft Ado
Agregar un módulo bas
Añadir un control ListBox y un ComboBox
Un Textbox
Un CommandButton
Dos OptionButton

Código fuente en el formulario

Option Explicit ' conexión y recordset ADO Dim cn As Connection Dim rs As Recordset Private Sub Command1_Click() If Len(Text1) Then If Option1 Then ' le pasa el combo, el recordset y el nombre de la columna Call Cargar(Combo1, rs, Text1) ElseIf Option2 Then ' le pasa el Listbox, el recordset y el nombre del campo Call Cargar(List1, rs, Text1) End If End If End Sub Private Sub Form_Load() Dim Connection_String As String ' cadena de conexión Connection_String = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=C:\Archivos de program" & _ "a\Microsoft Visual Studio\VB98\BIBLIO" & _ ".MDB;Persist Security Info=False" ' instancia el objeto ADODB Connection Set cn = New ADODB.Connection ' abre la base de datos cn.Open Connection_String ' nuevo objeto ADODB Recordset Set rs = New ADODB.Recordset ' cursor rs.CursorLocation = adUseClient ' lo abre y le pasa el sql rs.Open "SELECT * FROM Authors", cn, adOpenStatic, adLockOptimistic Command1.Caption = "Cargar" Text1.Text = "Author" Option1.Value = True Option1.Caption = "Cargar en ComboBox " Option2.Caption = "Cargar en Listbox " End Sub

Código fuente en el módulo bas

Option Explicit ' declaraciones api '''''''''''''''''''''''''''''''''''''''''' Private Declare Function SendMessageByString& _ Lib "user32" _ Alias "SendMessageA" ( _ ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As String) ' función que deshabilita el repintado de una ventana en windows Private Declare Function LockWindowUpdate& _ Lib "user32" ( _ ByVal hwndLock As Long) ' variables y constantes Private Const CB_ADDSTRING& = &H143 Private Const LB_ADDSTRING As Long = &H180 ' Función que carga el campo en el combobox o list ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function Cargar( _ ElControl As Object, _ rst As ADODB.Recordset, _ Columna As String) As Boolean Dim ret As Long Dim Mensaje_SendMessage As Long On Error GoTo error_function: ' verifica que el recordset contenga un conjunto de registros If rst.BOF And rst.EOF Then MsgBox " No hay registros para agregar", vbInformation Call LockWindowUpdate(0&) ' sale Exit Function End If ElControl.Parent.MousePointer = vbHourglass ' Chequea con TypeName el tipo de control enviado como parámetro If TypeName(ElControl) = "ComboBox" Then Mensaje_SendMessage = CB_ADDSTRING& ' mesanje para SendMessage ElseIf TypeName(ElControl) = "ListBox" Then Mensaje_SendMessage = LB_ADDSTRING ' mesanje para SendMessage End If ' deshabilita el repintado del control para que _ cargue los datos mas rapidamente Call LockWindowUpdate(ElControl.hWnd) DoEvents ' Posiciona el recordset en el primer registro rst.MoveFirst ' elimina todo el contenido del combo o listbox( opcional ) ElControl.Clear ' recorre las filas del recordset Do Until rst.EOF ' chequea que el valor no sea un nulo If Not IsNull(rst(Columna).Value) Then 'Agrega el dato en el control con el _ mensaje CB_ADDSTRING o LB_ADDSTRING dependiendo del tipo de control ret = SendMessageByString(ElControl.hWnd, _ Mensaje_SendMessage, _ 0, rst(Columna).Value) End If ' siguiente registro rst.MoveNext Loop ' selecciona el primer elemento del listado If ElControl.ListCount > 0 Then ElControl.ListIndex = 0 End If ' vuelve a habilitar el repintado Call LockWindowUpdate(0&) ' retorno Cargar = True ' reestablece el puntero del mouse ElControl.Parent.MousePointer = vbNormal Exit Function ' rutina de error error_function: MsgBox Err.Description, vbCritical ' En caso de error vuelve a activar el repintado Call LockWindowUpdate(0&) ElControl.Refresh ElControl.Parent.MousePointer = vbNormal End Function

Recursos vb.net

Enlazar DataSet con un Combo para cargar un campo en sql server

Recursos vb 6.0

Ejemplos de bases de datos en vb

Buscar en Recursos vb