Foros del Web » Programación para mayores de 30 ;) » Programación General » Visual Basic clásico »

Base de datos ADO y ListView

Estas en el tema de Base de datos ADO y ListView en el foro de Visual Basic clásico en Foros del Web. Hola!. Soy nuevo en este mundo y tengo mis dudas y mis problemas. Estoy haciendo un programa en Visual Basic donde hay un listview, una ...
  #1 (permalink)  
Antiguo 23/07/2011, 02:33
 
Fecha de Ingreso: marzo-2011
Mensajes: 21
Antigüedad: 13 años, 9 meses
Puntos: 1
Base de datos ADO y ListView

Hola!. Soy nuevo en este mundo y tengo mis dudas y mis problemas. Estoy haciendo un programa en Visual Basic donde hay un listview, una base de datos ADO, botones de ordenar, buscar, eliminar,agregar y modificar. El problema que tengo es que no puedo ni buscar, ni ordenar, ni eliminar, ni agregar ni modificar. En una palabra, lo unico que tengo es que se muestra los datos de la base de datos en el listview.
Este es el formulario principal:
Código:
Option Explicit

' Botones de opción
''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdOpciones_Click(Index As Integer)
    Select Case Index
        Case 0: Call Agregar
        Case 1: Call editar
        Case 2: Call Eliminar
        Case 3: Unload Me
        Case 4: buscar.Show , Me
        Case 5: Call mnuImprimir_Click
        End Select
End Sub


'Abre el formulario para Editar el registro seleccionado en el ListView
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub editar()

       
    ' verifica que hay datos en el ListView y que hay uno seleccionado
    If (lv.ListItems.Count = 0) Then
       MsgBox "No hay ningún registro para editar", vbInformation
       Exit Sub
    End If
    If (lv.SelectedItem Is Nothing) Then
       MsgBox "Debe seleccionar previamente un registro para poder editarlo", vbInformation
       Exit Sub
    End If
    With editar
        ' obtiene el elemento seleccionado
        .lblID = lv.SelectedItem.Text
        For i = 1 To 4
            .Text1(i).Text = lv.SelectedItem.ListSubItems(i).Text
        Next
       .ACCION = EDITAR_REGISTRO
        
        .Show vbModal
    End With
   
End Sub

' Elimina el registro actual seleccionado
'''''''''''''''''''''''''''''''''''''''''''''
Private Sub Eliminar()
    Dim nc As String
  
    nc = InputBox(" Escriba el número de cliente a eliminar. Esta acción es irreversible. ", " Eliminar ")
      
    If nc <> vbNullString Then
        'Ejecuta la sentencia SQL de eliminación
        cnn.Execute "DELETE FROM Clientes WHERE Nombre = '" & nc & "'"
    End If
  
End Sub

Sub Agregar()
    
    ' Acción
    editar.ACCION = AGREGAR_REGISTRO
    ' Abre el Form
    editar.Show 1
End Sub

Sub Salir()
    Call Desconectar
    Unload Me
    End
End Sub


Private Sub Form_Load()
    ' Abre la conexión
    Call IniciarConexion
    ' carga el Recorset con todos los datos
    rs.Open "select * from Clientes", cnn, adOpenStatic, adLockOptimistic
    ' llena el ListView
    Call CargarListView(lv, rs)

End Sub


Private Sub lv_DblClick()
    Call editar
End Sub



Private Sub lv_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim Item As ListItem
    
    Set Item = lv.HitTest(x, y)
    
    If Not Item Is Nothing And Button = vbRightButton Then
       Item.Selected = True
       Me.PopupMenu mnuEdicion
    End If
End Sub


' menues
'''''''''''''''''''''''''''''

Private Sub mnuAgregar_Click()
    Call Agregar
End Sub

Private Sub mnuEditar_Click()
    Call editar
End Sub

Private Sub mnuEliminar_Click()
    Call Eliminar
End Sub

' salir

''''''''''''''''''''''''
Private Sub mnuSalir_Click()
    Call Salir
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim ret As VbMsgBoxResult
    
    ret = MsgBox("¿Salir?", vbInformation + vbYesNo)
    If ret = vbNo Then
        Cancel = True
    Else
        Call Salir
    End If
End Sub
Siempre me salta este error al eliminar -2747217904

El formulario de buscar y ordenar:
Código:
Option Explicit

Private Sub ChameleonBtn1_Click()
    Unload Me
End Sub

' Ordena en forma Ascendente y descendente el LV
''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CmdOrdenar_Click(Index As Integer)
    CmdOrdenar(0).Value = False
    CmdOrdenar(1).Value = False
    CmdOrdenar(Index).Value = True
    Call Filtrar
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
       Unload Me
    End If
End Sub

Private Sub Form_Load()
    With FmPrincipal
        Me.Move (.Left + .lv.Left), _
                (.lv.Height + .lv.Top + .Top + 500)
    End With
    Call Filtrar
End Sub

Private Sub txtSearch_Change()
    Call Filtrar
End Sub

Private Sub Combo1_Click()
    Call Filtrar
End Sub

Private Sub Combo2_Click()
    Call Filtrar
End Sub

Public Sub Filtrar()
Dim Campo, OrderByCampo, Orden As String
Dim SQL As String

    If Combo1.ListIndex = -1 Then
        Combo1.ListIndex = 0
    End If
    If Combo2.ListIndex = -1 Then
        Combo2.ListIndex = 0
    End If
    If Combo1.ListIndex = 0 Then
        Campo = "Código"
    ElseIf Combo1.ListIndex = 1 Then
        Campo = "Nombre"
    ElseIf Combo1.ListIndex = 2 Then
        Campo = "Apellidos"
    End If
    If Combo1.ListIndex = 3 Then
         Campo = "Teléfono 1"
    End If
    
    Select Case Combo2.ListIndex
        Case 0: OrderByCampo = "Código"
        Case 1: OrderByCampo = "Nombre"
        Case 2: OrderByCampo = "Apellidos"
        Case 3: OrderByCampo = "Localidad"
    End Select

    If CmdOrdenar(0).Value Then Orden = "asc"
    If CmdOrdenar(1).Value Then Orden = "desc"

    ' si el recorset está abierto lo cierra
    If rs.State = adStateOpen Then
        rs.Close
    End If
    
    SQL = "SELECT * FROM Clientes Where " & _
                         Campo & " like '" & txtSearch & _
                        "%' order by " & OrderByCampo & " " & Orden
    
    rs.Open , cnn, adOpenStatic, adLockOptimistic
    
    Call CargarListView(FmPrincipal.lv, rs)

End Sub
Modulo:
Código:
Option Explicit

Public Declare Sub InitCommonControls Lib "comctl32" ()

' variables para la conexión y el recordset
''''''''''''''''''''''''''''''''''''''''''''
Public cnn As New ADODB.Connection
Public rs As New ADODB.Recordset

Public ObjItem As ListItem


Sub Main()
    On Error Resume Next
    Call InitCommonControls
    Err.Clear
    FmPrincipal.Show
End Sub

' abre
Public Sub IniciarConexion()

    With cnn
        .CursorLocation = adUseClient
        .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
              App.Path & "\datos.mdb" & ";Persist Security Info=False"
    End With

End Sub


Public Sub CargarListView(lv As ListView, rs As ADODB.Recordset)
    
    On Error GoTo ErrorSub
    
    Dim i As Integer
    'limpia el LV
    lv.ListItems.Clear
    
    ' si hay registros
    If rs.RecordCount > 0 Then
        
        ' recorre el recordset
        While Not rs.EOF
            ' añade los datos
            Set ObjItem = lv.ListItems.Add(, , rs(0))
                
           
           ObjItem.SubItems(1) = rs!nom
           ObjItem.SubItems(2) = rs!ap
           ObjItem.SubItems(3) = rs!dni
           ObjItem.SubItems(4) = rs!dir
           ObjItem.SubItems(5) = rs!cp
           ObjItem.SubItems(6) = rs!loc
           ObjItem.SubItems(7) = rs!pro
           ObjItem.SubItems(8) = rs!tel1
           ObjItem.SubItems(9) = rs!tel2
           ObjItem.SubItems(10) = rs!mov1
           ObjItem.SubItems(11) = rs!mov2
           ObjItem.SubItems(12) = rs!fax
                   
            ' siguiente registro
            rs.MoveNext
        Wend
        
    End If
    Call ForeColorColumn(&H8000&, 0, FmPrincipal.lv)
    'Call ForeColorColumn(vbRed, 6, FmPrincipal.lv)
    
    Exit Sub
    
ErrorSub:
    
    If Err.Number = 94 Then Resume Next
    
End Sub


' cierra
Sub Desconectar()
    On Local Error Resume Next
    rs.Close
    Set rs = Nothing
    cnn.Close
    Set cnn = Nothing
   End Sub

Muchas gracias por todo.
Un Saludo.

Última edición por juplagon; 24/07/2011 a las 04:37

Etiquetas: ado, basic, listview, sql, vb, visual
Atención: Estás leyendo un tema que no tiene actividad desde hace más de 6 MESES, te recomendamos abrir un Nuevo tema en lugar de responder al actual.
Respuesta




La zona horaria es GMT -6. Ahora son las 06:20.