Los ejemplos del 29 Sep 2001
Bases de datos ADO
(ActiveX Data Objects)

Actualizado el 29-Sep-2001

Volver a la p�gina de Bases de datos ADO



El c�digo completo y una captura del formulario en tiempo de dise�o, para Crear una base de datos, crear una tabla y compactar la base de datos, usando ADO.

Este link es para bajarte el c�digo completo: ejemplo29sep2001.zip 3.76 KB


El formulario en tiempo de dise�o:

 


El c�digo:


'------------------------------------------------------------------------------
' Ejemplo de crear Bases de datos y tablas con ADOX                 (28/Sep/01)
'
' �Guillermo 'guille' Som, 2001
'
' Las referencias usadas son:
' Microsoft ADO Ext. 2.6 for DDL and Security
' Microsoft Jet and Replication Objects 2.6 Library
'
' Para m�s informaci�n:
' Fuente:   Microsoft Data Access Components (MDAC) SDK
'           MDAC Technical Articles (MSDN Library)
' Art�culo: Defining and Retrieving a Database�s Schema
' Art�culo: Miscellaneous / Compacting a Database
'------------------------------------------------------------------------------
Option Explicit

Private Sub cmdCrearBase_Click()
    ' Crear una base de datos usando los datoos indicados en:       (28/Sep/01)
    ' txtNombreBase     El nombre (y path) de la base de datos
    ' cboProvider       El proveedor de la base de datos
    '
    Dim cat As ADOX.Catalog
    '
    ' Si se produce un error: interceptarlo
    On Error GoTo ErrCrearBase
    '
    Set cat = New ADOX.Catalog
    '
    ' Si existe la base de datos, preguntar si queremos borrarla
    If Len(Dir$(txtNombreBase.Text)) Then
        If MsgBox("La base de datos ya existe." & vbCrLf & _
                  "�Quieres Borrarla?", _
                    vbQuestion + vbYesNo + vbDefaultButton2 _
            ) = vbNo Then
            Exit Sub
        Else
            Kill txtNombreBase.Text
        End If
    End If
    '
    ' Crear la base de datos
    cat.Create "Provider=" & cboProvider.Text & ";" & _
               "Data Source=" & txtNombreBase.Text & ";"
    '
    MsgBox "Base de datos creada satisfactoriamente."
    '
    ' Para no "colarnos" en la rutina de error
    Exit Sub
    '
ErrCrearBase:
    ' Mostrar el mensaje de error
    MsgBox "Error al crear la base de datos:" & vbCrLf & _
            Err.Number & " " & Err.Description, _
            vbExclamation, "Error al crear la base de datos"
    Err.Clear
End Sub

Private Sub cmdCrearTabla_Click()
    ' Crear una tabla en la base de datos indicada                  (28/Sep/01)
    Dim cat As ADOX.Catalog
    Dim tbl As ADOX.Table
    '
    On Error GoTo ErrCrearTabla
    '
    Set cat = New ADOX.Catalog
    Set tbl = New ADOX.Table
    '
    ' Abrir el cat�logo
    cat.ActiveConnection = _
            "Provider=" & cboProvider.Text & ";" & _
            "Data Source=" & txtNombreBase.Text & ";"
    '
    ' Crear la nueva tabla
    With tbl
        .Name = txtNombreTabla.Text
        ' Crear los campos y a�adirlos a la tabla.
        ' Esto hay que hacerlo antes de a�adir la tabla a la colecci�n de tablas
        '
        .Columns.Append "ID", adInteger
        ' Dependiendo del tipo de proveedor, los datos de cadena ser�n de un tipo u otro
        If cboProvider.Text = "Microsoft.Jet.OLEDB.3.51" Then
            ' Para Access 97
            .Columns.Append "Nombre", adVarChar, 50         ' Una cadena de 50 caracteres
            .Columns.Append "email", adVarChar, 100
            .Columns.Append "Telefono", adVarChar
            .Columns.Append "Observaciones", adLongVarChar  ' Una cadena larga, (Memo)
        Else
            ' Para Access 2000
            .Columns.Append "Nombre", adVarWChar, 50        ' Una cadena de 50 caracteres
            .Columns.Append "email", adVarWChar, 100
            .Columns.Append "Telefono", adVarWChar
            .Columns.Append "Observaciones", adLongVarWChar ' Una cadena larga, (Memo)
        End If
        .Columns("Nombre").Attributes = adColNullable       ' Permite contener nulos
        .Columns("email").Attributes = adColNullable
        .Columns("Telefono").Attributes = adColNullable
        .Columns("Observaciones").Attributes = adColNullable
    End With
    '
    ' A�adir la nueva tabla a la base de datos
    cat.Tables.Append tbl
    '
SalirCrearTabla:
    Set tbl = Nothing
    Set cat = Nothing
    '
    Exit Sub
    '
ErrCrearTabla:
    ' Mostrar el mensaje de error
    MsgBox "Error al crear la tabla:" & vbCrLf & _
            Err.Number & " " & Err.Description, _
            vbExclamation, "Error al crear la tabla"
    Err.Clear
    Resume SalirCrearTabla
End Sub

Private Sub cmdCompactar_Click()
    ' Compactar una base de datos con ADO
    Dim sDBTmp As String
    Dim je As JRO.JetEngine
    '
    On Error GoTo ErrCompactar
    '
    Set je = New JRO.JetEngine
    '
    ' Crear un nombre "medio" aleatorio
    sDBTmp = "DBT_" & Format$(Minute(Now), "00") & Format$(Second(Now), "00") & ".mdb"
    ' Asegurarnos de que no existe una base con el nombre temporal
    If Len(Dir$(sDBTmp)) Then
        Kill sDBTmp
    End If
    '
    lblInfo.Caption = " Compactando la base de datos..."
    lblInfo.Refresh
    '
    ' Compactar la base de datos
    je.CompactDatabase "Data Source=" & txtNombreBase.Text & ";", _
                       "Data Source=" & sDBTmp & ";"
    '
    ' Eliminar la base de datos original
    Kill txtNombreBase.Text
    '
    ' Renombrar la base temporal con el original
    Name sDBTmp As txtNombreBase.Text
    '
    lblInfo.Caption = " Base de datos compactada."
    lblInfo.Refresh
    '
    Exit Sub
    '
ErrCompactar:
    ' Mostrar el mensaje de error
    MsgBox "Error al compactar la base de datos:" & vbCrLf & _
            Err.Number & " " & Err.Description, _
            vbExclamation, "Error al compactar la base de datos"
    Err.Clear
    lblInfo.Caption = " *** Error al compactar la base de datos ***"
    lblInfo.Refresh
End Sub

Private Sub Form_Load()
    With Me.cboProvider
        .AddItem "Microsoft.Jet.OLEDB.4.0"  ' (Access 2000)
        .AddItem "Microsoft.Jet.OLEDB.3.51" ' (Access 97)
        .ListIndex = 0
    End With
    txtNombreBase.Text = "PruebaADO.mdb"
    txtNombreTabla.Text = "Tabla1"
    lblInfo.Caption = "�Guillermo 'guille' Som, 2001" & IIf(Year(Now) > 2001, "-" & CStr(Year(Now)), "")
End Sub


ir al índice