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