Tips de visual Basic 6.0, Cargar los metadatos de una tabla, automatizar algunas tareas triviales o repetitivas ...

En alguna ocasión nos hemos visto en la necesidad de listar los metadatos de alguna tabla de nuestra base de datos (conocer el nombre del campo, su tipo de dato y su longitud) por ejemplo para crear una función que me permita insertar datos en una tabla. No es buena práctica escribir instrucciones SQL en el código fuente de nuestra aplicación ya que se hace una doble compilación lo cual hace que se pierda velocidad de ejecución, pero este ejemplo también lo pueden tomar para crear sus funciones mandando a llamar al procedimiento almacenado encargado de insertar datos (en caso de que el gestor de base de datos tenga soporte de sp por ejemplo Ms. SQL Server, MySql, etc).

Código fuente escrito en Ms. Visual Basic 6.0 atacando una base de datos de Ms. Access:

'----------------------------------------------------------------------------------------------
' Función escrita en Ms. Visual Basic 6.0 para leer los datos y metadatos
' de cualquier tabla que se le pase como parámetro ...

Public Function Auditar_X(Tabla As String) As ADODB.Recordset

    SQL = " SELECT * FROM " & Tabla
              
    cn.CursorLocation = adUseClient
    Set rs = cn.Execute(SQL)

    Set Auditar_X = rs
   
End Function
' Fin de la función ...

'----------------------------------------------------------------------------------------------
' Función que arma la función (valga la redundancia) para insertar datos en la tabla ARTICULOS ...

Private Sub cmdAceptar_Click()
    On Error GoTo e
   
    Dim ArtTipoDato As String, Art As String
    Dim Tabla As String, Valores As String
    Dim ComillasDobles As String
   
    '   Chr(10) = ENTER
    '   Chr(13) = TABULADOR
   
    ComillasDobles = """"
    Tabla = "ARTICULOS"
    Valores = ComillasDobles & vbTab & vbTab & " VALUES ("
    Art = "SQL = " & ComillasDobles & vbTab & "INSERT INTO " & Tabla & "("
   
    If Me.ListView1.ListItems(1).Selected Then
        frmCatDocumentos.Show 1
    End If
   
    If Me.ListView1.ListItems(2).Selected Then
        'MsgBox "Kardex"
        Dim i As Integer
       
        Set rs = Me.Auditar_X(Tabla)
       
        Me.List1.Clear
       
        ArtTipoDato = "Public Sub Insertar" & Tabla & "("
       
        For i = 0 To rs.Fields.Count
            'Me.List1.AddItem rs.Fields(i).Name & " -- " & TypeName(rs.Fields(i).Value) & " -- " & rs.Fields(i).DefinedSize
            Me.List1.AddItem rs.Fields(i).Name & " As " & TypeName(rs.Fields(i).Value) & ","
           
            ArtTipoDato = ArtTipoDato & rs.Fields(i).Name & " As " & TypeName(rs.Fields(i).Value) & ","
           
            Art = Art & rs.Fields(i).Name & ","
           
            If UCase(TypeName(rs.Fields(i).Value)) = "STRING" Then
                Valores = Valores & "'" & ComillasDobles & " & " & rs.Fields(i).Name & " & " & ComillasDobles & "',"
            End If
           
            If UCase(TypeName(rs.Fields(i).Value)) = "DATE" Then
                Valores = Valores & "#" & ComillasDobles & " & " & rs.Fields(i).Name & " & " & ComillasDobles & "#,"
                'Valores = Valores & "#" & rs.Fields(i).Name & "#,"
            End If
           
            If UCase(TypeName(rs.Fields(i).Value)) = "LONG" Or UCase(TypeName(rs.Fields(i).Value)) = "DOUBLE" Then
                Valores = Valores & "" & ComillasDobles & " & " & rs.Fields(i).Name & " & " & ComillasDobles & ","
                'Valores = Valores & "" & rs.Fields(i).Name & ",& "
            End If
           
            'MsgBox rs.Fields(i).Name
            'MsgBox rs.Fields(i).Value
            'MsgBox TypeName(rs.Fields(i).Value)
        Next i
    End If
   
    'MsgBox ArtTipoDato
   
    ArtTipoDato = Left(ArtTipoDato, Len(ArtTipoDato) - 1)
    ArtTipoDato = ArtTipoDato & ")"
   
    Art = Left(Art, Len(Art) - 1)
    Art = Art & ")" & ComillasDobles & " & _"
   
    Valores = Left(Valores, Len(Valores) - 1)
    Valores = Valores & ")"
   
    Me.lb.Caption = ArtTipoDato & Art & Valores
    Valores = Valores & " Set rs = cn.Execute(SQL)"
    Valores = Valores & "End sub"
    Me.Te.Text = ArtTipoDato & Chr(13) & Art & Chr(13) & Valores
   
    If Me.ListView1.ListItems(3).Selected Then
        frmCatArticulos.Show 1
    End If
   
    If Me.ListView1.ListItems(4).Selected Then
        MsgBox "Salir"
    End If
e:
Resume Next
End Sub
'----------------------------------------------------------------------------------------------

' Esta es la función que resultó de ejecutar el código anterior ...

Public Sub InsertarARTICULOS(ARTICULO As String, DESCRIPCION As String,
    PROVEEDOR As String, UMP_C As String, UMP_V As String,
    FACTOR_CONVER As Long, COSTO_UMC As Double, COSTO_UMV As Double,
    PRECIO_V As String, ACTIVO As String, USR_CREACION As String,
    FECHA_HORA_CREACION As Date, USR_MODIFICACION As String,
    FECHA_HORA_MODIFICACION As Date)
       
    SQL = " INSERT INTO ARTICULOS(ARTICULO,DESCRIPCION,PROVEEDOR,
        UMP_C,UMP_V,FACTOR_CONVER,COSTO_UMC,COSTO_UMV,PRECIO_V,
        ACTIVO,USR_CREACION,FECHA_HORA_CREACION,USR_MODIFICACION,
        FECHA_HORA_MODIFICACION)" & _
                " VALUES ('" & ARTICULO & "','" & DESCRIPCION & "','" & PROVEEDOR
        & "','" & UMP_C & "','" & UMP_V & "'," & FACTOR_CONVER & ","
        & COSTO_UMC & "," & COSTO_UMV & ",'" & PRECIO_V & "','" & ACTIVO
        & "','" & USR_CREACION & "',#" & FECHA_HORA_CREACION & "#,'"
        & USR_MODIFICACION & "',#" & FECHA_HORA_MODIFICACION & "#)"
    Set rs = cn.Execute(SQL)
End Sub

' Fin de la función ...

'----------------------------------------------------------------------------------------------

Ahora ya está lista la función InsertarARTICULOS para ser agregada y llamada desde cualquier parte del programa. Cuánto tiepo nos llevó obtener la función InsertarARTICULOS pues yo diría que SEGUNDOS, y cuanto tiempo nos tomaría escribirla a pie pues yo diría que minutos .....

---

---