CRUD Visual Basic 6 a SQL Server 2019

A continuación les indicare paso a paso como conectar Visual Basic 6 a un Base de Datos SQL Server.

Pasos

Creación de la Base de datos.
Crear un Proyecto Nuevo de Visual Basic
Agregar las Referencias en Visual Basic
Crear el Módulo de conexión
Crear la Función que hará la conexión
CRUD haciendo Pruebas de consultas a la base de datos
Generando el Punto Exe

Creación de la Base de Datos

Se debe crear una base de datos con el nombre de crud_vb6_sqlserver y el código para crear la tabla es el siguiente:

USE [crud_vb6_sqlserver]
GO
/****** Object:  Table [dbo].[tblclientes]    Script Date: 21/05/2022 11:13:04 p. m. ******/SET ANSI_NULLS ON
GO
SET QUOTED_IDENTIFIER ON
GO
CREATE TABLE [dbo].[tblclientes](
  [id_cliente] [int] IDENTITY(1,1) NOT NULL,
  [identificacion] [nchar](15) NULL,
  [nombres] [nchar](80) NULL,
 CONSTRAINT [PK_tblclientes] PRIMARY KEY CLUSTERED 
(
  [id_cliente] ASC
)WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON, OPTIMIZE_FOR_SEQUENTIAL_KEY = OFF) ON [PRIMARY]
) ON [PRIMARY]
GO

Crear un Proyecto Nuevo de Visual Basic

Abre Visual Basic 6 y vas a seleccionar un proyecto Profesional de Visual Basic, la versión profesional es las mas usada debido a que trae todos los controles.

En el formulario que se abre vas a diseñar el formulario de la siguiente manera ya que la idea que hacer un CRUD (Crea, Modifica, Listar y Eliminar).

Lista de Controles:

txtIdentificacion
txtNombres
MSHGrid
cmdNuevo
cmdGuardar
cmdSalir

Agregar las Referencias en Visual Basic

Para poder hacer la conexión a una base de datos usando ADO se debe agregar esa referencia a Visual Basic, para agregarla debe ir al Menú Proyecto, luego en Referencias.

Se debe buscar en la lista la referencia Microsoft ActiveX Data Object 2.5 Library, para agregarla solo debe darle clic en el cuadrito para que active el chulito y luego dar en el botón aceptar.

Con esto ya queda habilitado Visual Basic para realizar conexiones a base de datos utilizando ADO.

Crear el Módulo de conexión

Para agregar un módulo a Visual Basic, debes dar clic en el Menú Proyecto y luego en Agregar Módulo y Luego clic en botón Abrir.

Se le cambia el nombre al módulo por mdoConexion

El código del módulo seria el siguiente:

Global ConexionADO As New ADODB.Connection

Sub AbrirConexionADO()
  On Error GoTo error
    sConnectionString = "PROVIDER = MSDASQL;driver={SQL Server};database=crud_vb6_sqlserver ;server=DESKTOP-6PK3P44\FERNANDO;uid=;pwd=;"
    
    If ConexionADO.State = 1 Then
       ConexionADO.Close
    End If
    
    ConexionADO.CursorLocation = adUseClient
    ConexionADO.Open sConnectionString
          
    'MsgBox "Conectado"
 Exit Sub
    MsgBox Err.Description, vbCritical, "Error al conectarse"
    
End Sub


'Este procedimiento se encarga de llenar un MSHFlexGrid
'Se le debe pasar el nombre del MSHFlexGrid, la consulta SQL y el total de columnas
Sub ListarGridMSH(Grid As MSHFlexGrid, sql, totalCampos)
     Dim RecorsetTemp As New ADODB.Recordset
    
     RecorsetTemp.Open sql, ConexionADO, adOpenStatic, adLockReadOnly
     
   
    Grid.Redraw = False
    Grid.Rows = 1
    Grid.FixedRows = 0
    Grid.Rows = 0

    Grid.DataMember = RecorsetTemp.DataMember
    Set Grid.DataSource = RecorsetTemp.DataSource
    
    TotalColumnas = totalCampos
    
    Grid.AddItem "", 0
    
    If Grid.Rows > 1 Then Grid.FixedRows = 1
   
    ww = 70
    For cc = 0 To Grid.Cols - 1
        ww = ww + Grid.ColWidth(cc)
    Next
    If Grid.RowHeight(0) * Grid.Rows > Grid.Height Then
        ww = ww + 240
    End If
    
    For i = 1 To TotalColumnas
                Grid.Row = 0
                Grid.Col = i
                Grid.CellBackColor = &H8C5828 '&HFFCCAB
                Grid.CellAlignment = flexAlignCenterCenter
                Grid.CellForeColor = vbWhite
                Grid.CellFontBold = True
    Next i
    
    Grid.Row = 0
    suma = 0
    For cc = 1 To Grid.Rows - 1
        Grid.Row = cc
 
        If cc Mod 2 = 0 Then
            For i = 1 To TotalColumnas
                Grid.Col = i
                Grid.CellBackColor = &HFEEEDD
            Next i
        End If
        Grid.Row = cc
        Grid.Col = 1
        Grid.CellAlignment = flexAlignLeftCenter
    Next
    
    
    Grid.Redraw = True
    Grid.Col = 0
    If Grid.Row > 0 Then
        Grid.Row = 1
       ' Grid.SetFocus
    End If
    
End Sub

Luego en el evento Load del formulario se llama al procedimiento que abre la conexón con la base de datos:

Private Sub Form_Load()
    Call AbrirConexionADO
End Sub

El código completo del CRUD es el siguiente:

Dim IdCliente As Integer 'Esta variable se utiliza para saber si se actualiza o no un registro

'Lista la lista de clientes actuales en la tabla Clientes
Sub ListarClientes()
    sql = "Select [id_cliente] ,[identificacion],[nombres] from [dbo].[tblclientes] Order by [nombres] ASC "
    
    Call ListarGridMSH(MSHGrid, sql, 3)
    
    MSHGrid.ColWidth(0) = 0
    MSHGrid.ColWidth(1) = 1200
    MSHGrid.ColWidth(2) = 1400
    MSHGrid.ColWidth(3) = 3000

    
    MSHGrid.TextMatrix(0, 1) = "Codigo"
    MSHGrid.TextMatrix(0, 2) = "Identificación"
    MSHGrid.TextMatrix(0, 3) = "Nombres"
    
End Sub

Sub ConsultarClientes()
    sql = "Select [id_cliente] ,[identificacion],[nombres] from [dbo].[tblclientes] where [nombres] like '" & txtNombres & "' Order by [nombres] ASC "
    
    Call ListarGridMSH(MSHGrid, sql, 3)
    
    MSHGrid.ColWidth(0) = 0
    MSHGrid.ColWidth(1) = 1200
    MSHGrid.ColWidth(2) = 1400
    MSHGrid.ColWidth(3) = 3000

    
    MSHGrid.TextMatrix(0, 1) = "Codigo"
    MSHGrid.TextMatrix(0, 2) = "Identificación"
    MSHGrid.TextMatrix(0, 3) = "Nombres"
    
End Sub

'Elimina un cliente por su ID
Private Sub cmdEliminar_Click()
    On Error GoTo error
    
    id = MSHGrid.TextMatrix(MSHGrid.Row, 1)
    nombre = MSHGrid.TextMatrix(MSHGrid.Row, 3)
    If id <> "" Then
       res = MsgBox("¿Está seguro de borrar al cliente: " & nombre & " ?", vbYesNo, "Confirmar")
       If res = vbYes Then
          sql = "Delete from [dbo].[tblclientes] where [id_cliente] = " & id
          ConexionADO.Execute sql
          
          Call ListarClientes
          
       End If
    End If
    
      Exit Sub
error:
  MsgBox Err.Description, vbCritical, "Error Nº " & Err.Number
End Sub

Private Sub cmdGuardar_Click()
  On Error GoTo error
    
    If IdCliente = 0 Then 'se es cero se agrega uno nuevo
        sql = "Insert into [dbo].[tblclientes] ([identificacion], [nombres]) values ('" & txtIdentificacion & "', '" & Me.txtNombres & "')"
    Else 'sino se actualiza
        sql = "Update [dbo].[tblclientes] SET [identificacion] = '" & txtIdentificacion & "', [nombres] = '" & Me.txtNombres & "' Where [id_cliente] = " & IdCliente
    End If
        ConexionADO.Execute sql
        
    Call ListarClientes
    Call cmdNuevo_Click
  Exit Sub
error:
  MsgBox Err.Description, vbCritical, "Error Nº " & Err.Number
    
End Sub

Private Sub cmdNuevo_Click()
    Me.Caption = "CRUD SQL Server"
    IdCliente = 0
    txtIdentificacion.Text = ""
    txtNombres.Text = ""
    txtIdentificacion.SetFocus
    
    Call ListarClientes
End Sub

Private Sub cmdSalir_Click()
    Unload Me
End Sub


Private Sub Form_Load()
    Call AbrirConexionADO
    IdCliente = 0
    Call ListarClientes
End Sub

'si se da doble clic se procede a llenar los campos del formulario con los datos del Cliente
Private Sub MSHGrid_DblClick()
    id = MSHGrid.TextMatrix(MSHGrid.Row, 1)
    ident = MSHGrid.TextMatrix(MSHGrid.Row, 2)
    nombre = MSHGrid.TextMatrix(MSHGrid.Row, 3)
    If id <> "" Then 'en caso que no se le de doble clic a un cliente
        IdCliente = id
        txtIdentificacion.Text = ident
        txtNombres.Text = nombre
        Me.Caption = "CRUD MySQL - Modificando el cliente ID: " & IdCliente
    End If
End Sub

El formulario final quedó de la siguiente manera: