Bases de datosAPI'S PARA LAS BASES DE DATOS
(43 Rutinas disponibles)
Abrir una base de datos con seguridad en ADO
A través de este ejemplo mostraremos como abrir mediante ADO una base de datos
de Access protegida con contraseña.
Dim Cn As New ADODB.Connection
Dim strCn As String
strCn = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=nwind.MDB;" & _
"Jet OLEDB:System database=c:\winnt\system32\System.MDW"
Cn.Open ConnectionString:=strCn, _
UserID:="Admin", Password:="ambsoftware"
Acceso con y sin claves a todas las bases de datos
A continuación se muestran varias rutinas todas ellas encaminadas a acceder a
todas las bases de datos, estén o no protegidas con contraseña.
Abrir una Tabla de Fox o dBase o... desde código
Menu Proyecto->Referencias Seleccionar DAO 3.51
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Set dbs = OpenDatabase("C:\Via\", True, False, "FoxPro 2.5")
Set rs = dbs.OpenRecordset("Libros")
Abrir Base de Datos de Access 97 Sin PassWord para asociarla con un Control Data
Insertar un Control DATA
Desde Código
Data1.DatabaseName = "c:\Via\ACCESS97.MDB"
Data1.RecordSource = "Tabla"
Data1.Refresh
ó
En la Ventana de Propiedades del Objeto
DatabaseName = "c:\Via\ACCESS97.MDB"
RecordSource = "Tabla"
Abrir Base de Datos de Access 97 con PassWord para asociarla con un Control Data
Insertar un Control DATA
Desde Código
Dim cPass as String
Dim Clave as String
Clave = "Password"
cPass = ";PWD=" & Clave
Data1.DatabaseName = "c:\Via\ACCESS97.MDB"
Data1.RecordSource = "Tabla"
Data1.Connect = cPass
Data1.Refresh
Abrir Base de Datos de Access 97 SIN PassWord desde Código y Sin Data Control
Menu Proyecto->Referencias Seleccionar DAO 3.51
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Set dbs = OpenDatabase("C:\Via\ACCESS97.MDB", True, False,)
Set rs = dbs.OpenRecordset("Tabla")
Abrir Base de Datos de Access 97 CON PassWord desde Código y Sin Data Control
Menu Proyecto->Referencias Seleccionar DAO 3.51
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim cPass as String
Dim Clave as String
Clave = "Password"
cPass = ";PWD=" & Clave
Set dbs = OpenDatabase("C:\Via\ACCESS97.MDB", True, False, cPass) 'no se deben
omitir el segundo ni el tercer parámetro para que entre el password
Set rs = dbs.OpenRecordset("Tabla")
Abrir Base de Datos de Access 2000 Sin PassWord para asociarla con un Control
Data
Insertar un Control DATA y no especificarle nada en la ventana de propiedades
si se desea ver los datos en una grilla, insertar un "bound dbgrid" y asociarlo
al Control Data
Desde Código
Menu Proyecto->Referencias Seleccionar DAO 3.6
en algun procedimiento...
Dim dbsdao36 As DAO.Database
Dim rs As DAO.Recordset
Set dbsdao36 = OpenDatabase("Base de Datos.mdb", False, False)
Set rs = dbsdao36.OpenRecordset("Tabla")
Set Data1.Recordset = rs
Abrir Base de Datos de Access 2000 CON PassWord para asociarla con un Control
Data
Insertar un Control DATA y no especificarle nada en la ventana de propiedades
si se desea ver los datos en una grilla, insertar un "bound dbgrid" y asociarlo
al Control Data
Desde Código
Menu Proyecto->Referencias Seleccionar DAO 3.6
en algun procedimiento...
Dim dbsdao36 As DAO.Database
Dim rs As DAO.Recordset
Dim cPas As String
cPas = ";pwd=password"
Set dbsdao36 = OpenDatabase("Base de Datos.mdb", False, False, cPas)
Set rs = dbsdao36.OpenRecordset("Tabla")
Set Data1.Recordset = rs
Abrir Base de Datos de Access 2000 SIN PassWord desde Código y Sin Data Control
Menu Proyecto->Referencias Seleccionar DAO 3.6
Dim dbsdao36 As DAO.Database
Dim rsdao36 As DAO.Recordset
Set dbsdao36 = OpenDatabase("C:\Via\ACCESS2000.MDB", True, False,)
Set rsdao36 = dbs.OpenRecordset("Tabla")
Abrir Base de Datos de Access 97 CON PassWord desde Código y Sin Data Control
Menu Proyecto->Referencias Seleccionar DAO 3.6
Dim dbsDao36 As DAO.Database
Dim rsDao36 As DAO.Recordset
Dim cPass as String
Dim Clave as String
Clave = "Password"
cPass = ";PWD=" & Clave
Set dbsDao36 = OpenDatabase("C:\Via\ACCESS2000.MDB", True, False, cPass) 'no se
deben omitir el segundo ni el tercer Parámetro para que entre el password
Set rsDao36 = dbs.OpenRecordset("Tabla")
Abrir Base de Datos de Access 97 Sin PassWord para asociarla con un Control ADO
Insertar un Control ADO
Desde Código
Dim Clave as String
Clave = ""
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" _
& "Data Source=" & "ACCESS97.MDB" & ";" _
& "Persist Security Info=False;" _
& "Jet OLEDB:Database Password=" & Clave 'jet 3.51 para access 97
Adodc1.Mode = adModeRead ' elejir el modo
Adodc1.RecordSource = "Tabla"
Adodc1.Refresh
Abrir Base de Datos de Access 97 con PassWord para asociarla con un Control ADO
Insertar un Control ADO
Desde Código
Dim Clave as String
Clave = "password"
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" _
& "Data Source=" & "ACCESS97.MDB" & ";" _
& "Persist Security Info=False;" _
& "Jet OLEDB:Database Password=" & Clave 'jet 3.51 para access 97
Adodc1.Mode = adModeRead ' elejir el modo
Adodc1.RecordSource = "Tabla"
Adodc1.Refresh
Abrir Base de Datos de Access 2000 Sin PassWord para asociarla con un Control
ADO
Insertar un Control ADO
Desde Código
Dim Clave as String
Clave = ""
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "ACCESS97.MDB" & ";" _
& "Persist Security Info=False;" _
& "Jet OLEDB:Database Password=" & Clave 'jet 4.0 para access 2000
Adodc1.Mode = adModeRead ' elejir el modo
Adodc1.RecordSource = "Tabla"
Adodc1.Refresh
Abrir Base de Datos de Access 2000 Sin PassWord para asociarla con un Control
ADO
Insertar un Control ADO
Desde Código
Dim Clave as String
Clave = "password"
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "ACCESS97.MDB" & ";" _
& "Persist Security Info=False;" _
& "Jet OLEDB:Database Password=" & Clave 'jet 4.0 para access 2000
Adodc1.Mode = adModeRead ' elejir el modo
Adodc1.RecordSource = "Tabla"
Adodc1.Refresh
Añadir un base de datos a un servidor SQL
Mediante este ejemplo, podremos añadir una base de datos a un servidor SQL.
PURPOSE: Creates a Database for an SQL Server
PARAMETERS: ServerName: Name of SQLServer
DatabaseName: Name of Database to Delete
UserID: LoginID for SQL Server.
User must have sysadmin or
dbcreator privileges
Password: Password for SQL Server
DatabaseFileName: FileName for Database
AddTables: List of Tables to attach to the db.
If you don't want
to add tables, pass "" as this parameter
RETURNS: True if successful, false otherwise
REQUIRES: Reference to Microsoft SQLDMO object library
EXAMPLE: AddSQLDatabase "MySQLServer", "NewDB", "sa", "myPassword", _
"C:\Program Files\Microsoft SQL Server\MSSQL\Data\NewDB.mdf", "Newtable1",
"NewTable2"
NOTES: Tested with SQL 2000. Should work with SQL 7.0
Public Function AddSQLDatabase(ByVal ServerName As String, ByVal DatabaseName As
String, ByVal UserID As String, ByVal Password As String, ByVal DatabaseFileName
As String, ParamArray AddTables() As Variant) As Boolean
Dim oSQLServer As New SQLDMO.SQLServer
Dim oDatabase As New SQLDMO.Database
Dim oDBFile As New SQLDMO.DBFile
Dim oApp As New SQLDMO.Application
Dim oFileGroup As SQLDMO.FileGroup
Dim oTable As SQLDMO.Table
Dim lCtr As Long
Dim oColumn As SQLDMO.Column
On Error GoTo ErrorHandler
With oSQLServer
.Connect ServerName, UserID, Password
.Database.Name = DatabaseName
' This uses default properties of the dbfile. If you want to change
these, set optional properties, such as MaximumSize
.oDBFile.Name = DatabaseName
.oDBFile.PhysicalName = DatabaseFileName
.Set oFileGroup = oDatabase.FileGroups.Item("PRIMARY")
.oFileGroup.DBFiles.Add oDBFile
.Databases.Add oDatabase
For lCtr = 0 To UBound(AddTables)
If CStr(AddTables(lCtr)) <> "" Then
Set oTable = New SQLDMO.Table
oTable.Name = AddTables(lCtr)
'You must add at least one colummn.
'I'm adding a default identity col named
'id. If you want to control this,
'add more parameters to the function
Set oColumn = New SQLDMO.Column
oColumn.Datatype = "int"
oColumn.Identity = True
oColumn.Name = "ID"
oTable.Columns.Add oColumn
oDatabase.Tables.Add oTable
End If
Next
End With
AddSQLDatabase = True
ErrorHandler:
Set oSQLServer = Nothing
Set oDatabase = Nothing
Set oDBFile = Nothing
Set oFileGroup = Nothing
End Function
Añadir una nueva tabla a una base de datos
Desde este código podremos crear una nueva tabla en una base de datos existente.
Public Function CreateTable(DatabaseName As String, ByVal TableName As String)
As Boolean
'DataBaseName es el path de su base de datos
'TableName es el nombre de la tabla que quiere crear
'Returns True si se crea o Falso en otro caso
On Error GoTo errorhandler
Dim oDB As DAO.Database
Dim td As DAO.TableDef
Dim f As DAO.Field
Set oDB = Workspaces(0).OpenDatabase(DatabaseName)
On Error GoTo errorhandler
If TableExists(oDB, TableName) Then GoTo errorhandler
'Create table object
Set td = oDB.CreateTableDef(TableName)
'Debemos añadir un campo
Set f = td.CreateField("ID", dbLong)
f.Attributes = dbAutoIncrField
td.Fields.Append f
oDB.TableDefs.Append td
oDB.Close
CreateTable = True
Exit Function
errorhandler:
If Not oDB Is Nothing Then oDB.Close
Set td = Nothing
Set f = Nothing
End Function
Private Function TableExists(oDB As Database, TableName As String) As Boolean
Dim td As DAO.TableDef
On Error Resume Next
Set td = oDB.TableDefs(TableName)
TableExists = Err.Number = 0
End Function
Añadir una nueva tabla a una base de datos(II)
Otra forma de añadir una nueva tabla en una base de datos de Microsoft Access.
Function Crea_Tabla(Conexion As ADODB.Connection, NombreDB As String,
NombreTabla As String) As Boolean
Dim cat As New ADOX.Catalog
Dim tdfActual As New ADOX.Table
On Error GoTo ErrorCrea_Tabla
Crea_Tabla = False
If Trim$(NombreTabla) <> "" Then
' Abre el catálogo.
Set cat.ActiveConnection = Conexion
'Vemos si existe la tabla, si existe en tdfActual tengo el enlace de la
tabla si no lo tengo que cear
If Not ExisteTabla(cat, NombreTabla, tdfActual) Then
'Creo la tabla si no existe previamente
tdfActual.Name = NombreTabla
cat.Tables.Append tdfActual
End If
End If
Crea_Tabla = True
Exit Function
ErrorCrea_Tabla:
MuestraError, "Crea_Tabla", Err, Error
End Function
Apertura mediante un control Data de una Base de Datos con Password
Este ejemplo nos muestra como abrir una base de datos desde Visual Basic
protegida con contraseña.
Vamos a suponer que la base de datos se llama Bd1.mdb.
Genere una contraseña para la nueva base de datos creada.
Para este ejemplo, he creado la contraseña "Amb".
Tenga cuidado con las mayúsculas y minúsculas, ya que Access hace distinción
entre ellas.
Se ha dispuesto para este ejemplo las siguientes propiedades de tabla:
Nombre de la tabla: Tabla1
Nombre del Campo Tipo de datos Tamaño:
Nombre Carácter 50
Apellido1 Carácter 50
Apellido2 Carácter 50
Edad Numérico Entero
Ejemplo:
Añada 4 cajas de texto y un control Data al formulario, el cual por defecto
llevará el nombre de Data1.
Cambie la propiedad DataSource de todas las cajas de texto a Data1.
A continuación escriba el siguiente código.
Private Sub Form_Load()
Data1.DatabaseName = "C:\Temp\Bd1.mdb"
Data1.RecordSource = "Tabla1"
Data1.Connect = ";pwd=Amb"
Text1.DataField = "Nombre"
Text2.DataField = "Apellido1"
Text3.DataField = "Apellido1"
Text4.DataField = "Edad"
End Sub
Cambiar la localización de una BD de un DataEnvironment en tiempo de ejecución
El siguiente ejemplo nos muestra cómo podemos cambiar la localización de una
base de datos de un DataEnvironment en tiempo de ejecución.
1. Obtenga la cadena de conexión que dió en tiempo de diseño:
Debug.Print DE.Connections(1).ConnectionString
(DE es el nombre del DataEnvironment en el ejemplo),
2. En el inicio de su programa escriba algo similar al siguiente corte de
código, preservando su cadena de conexión (modifica solo la localización de la
base de datos, en este caso yo use la variable ArchivoBaseDeDatos)
Private Sub Form_Initialize()
Dim s As String
s = "Provider=MSDataShape.1;" & "Persist Security Info=False;" & "Data
Source=" & ArchivoBaseDeDatos & ";" & "Data Provider=MICROSOFT.JET.OLEDB.4.0"
DE.Connections(1).ConnectionString = s
End Sub
Cargar los datos de un Recordset en un control MSFlexGrid
A través de este ejemplo podremos cargar los datos de un Recordset en un control
MsFlexGrid.
Public Sub CargarGRID(Grid As MSFlexGrid, RST As Recordset)
Dim NroColumnas, ActColumna As Long
NroColumnas = Grid.Cols - 1
Grid.Rows = 1
Do While Not RST.EOF
Grid.Rows = Grid.Rows + 1
Grid.Row = Grid.Rows - 1
For ActColumna = 0 To NroColumnas
Grid.Col = ActColumna
Grid.Text = RST.Fields(ActColumna)
Next ActColumna
RST.MoveNext
Loop
End Sub
'Declaramos la variable de base de datos y recordset
Dim MiBD as Database
Dim MiRecordset as Recordset
Dim PathBaseDeDatos,NombreRecordset as String
'Abrimos la base de datos y establecemos el valor del recordset
PathBaseDeDatos=App.Path & "\MIBD.MDB"
'NombreRecordset puede ser el nombre de una tabla de la base de datos
'o bien una consulta SQL, por ejemplo:
' NombreRecordset="SELECT * FROM Alumnos;"
NombreRecordset="Alumnos"
Set MiBD=OpenDatabase(PathDeLaBaseDeDatos)
Set MiRecordset=MiBD.OpenRecordset(NombreRecordset)
'Y ahora cargamos los datos ...
CargarGrid MSFlexGrid1, MiRecordset
Cómo cerrar conexiones implícitas
El ejemplo siguiente nos muestra cómo podemos con una sencilla rutina cerrar
conexiones implícitas resultantes de abrir objetos recordsets independientes.
En Visual Basic 6.0 es posible abrir objetos recordsets independientes sin
asociarlos a ninguna conexión. Esto es posible gracias al carácter no jerárquico
del modelo de programación de ADO. No obstante, cada vez que se abre un
recordset de este tipo, se crea una conexión implícita. Esto supone que si el
objeto recordset se cierra y se abre varias veces en el código del proyecto, se
crearán tantas nuevas conexiones como veces se haya abierto el objeto recordset.
Estas conexiones permanecerán abiertas hasta cerrar el proyecto.
Para impedir esto, y conseguir cerrar la conexión implícita a cada recordset
independiente, se puede utilizar la siguiente técnica, que asocia a una variable
Connection la conexión implícita a un recordset independiente, cerrando dicha
conexión antes de reabrir el recordset.
Dim rst1 As New ADODB.Recordset
Dim cnn As New ADODB.Connection
Private Sub Command1_Click()
rst1.Open "authors", "Provider = sqloledb;Data Source=myServer;" & "Initial
Catalog=pubs;User Id=sa;Password=;", adOpenStatic, adLockReadOnly
End Sub
Private Sub Command2_Click()
Set cnn = rst1.ActiveConnection
rst1.Close
cnn.Close
rst1.Open "publishers","Provider = sqloledb;Data Source=myServer;" &
"Initial Catalog=pubs;User Id=sa;Password=;", adOpenStatic, adLockOptimistic
End Sub
Compacta una base de datos de Access
Mediante este código lograremos compactar una base de datos de Microsoft Access.
Public Function compactDB(ByVal SOUR_path As String, ByVal DEST_path As String)
As Boolean
On Error GoTo Err_compact
Private JRO As New JRO.JetEngine
Private DB_sour As String, DB_dest As String
DoEvents
DB_sour = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SOUR_path
DB_dest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DEST_path & " ;Jet
OLEDB:Engine Type=5"
JRO.CompactDatabase DB_sour, DB_dest
compactDB = True
Exit Function
Err_compact:
compactDB = False
MsgBox Err.Description, vbExclamation
End Function
Compacta una base de datos de Access(II)
Este es otro ejemplo de cómo compactar una base de datos de Access desde Visual
Basic.
Function Compactar(Origen As String, Destino As String) As Boolean
'Hay que introducir la referencia Microsoft Jet and Replication
Dim Jet As New JRO.JetEngine
Dim BDOrigen As String
Dim BDDestino As String
On Error GoTo ErrorCompactar
Compactar = False
'Para conectar con BD Access 2000 usar el proveedor Microsoft.Jet.OLEDB.4.0.
'Para conectar con Access 97 usar Microsoft.Jet.OLEDB.3.51
BDOrigen = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Origen
BDDestino = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Destino & "
;Jet OLEDB:Engine Type=5"
Jet.CompactDatabase BDOrigen, BDDestino
Compactar = True
Exit Function
ErrorCompactar:
MuestraError , "Compactar", Err, Error
End Function
Comprobar la existencia de un campo en una BD
El ejemplo siguiente nos muestra cómo podemos comprobar la existencia de un
campo determinado dentro de una base de datos de Access.
Function ExisteCampo(cat As ADOX.Catalog, tdfActual As ADOX.Table, NombreCampo
As String) As Boolean
Dim fldBucle As New ADOX.Column
On Error GoTo ErrorExisteCampo
ExisteCampo = False
For Each fldBucle In tdfActual.Columns
If fldBucle.Name = NombreCampo Then
ExisteCampo = True
Exit For
End If
Next fldBucle
Exit Function
ErrorExisteCampo:
MuestraError "ExisteCampo", Err, Error
End Function
Conectarnos a una base de datos de Internet
Mediante el ejemplo siguiente podremos conectarnos a una base de datos que esté
en Internet.
server = "200.121.121.2" 'Tu servidor
source = "c:\temp\data1.mdb" 'El path de la base de datos
Adodc1.ConnectionString = "Provider=MS Remote;" & "Remote Server=" & server &
";" & "Remote Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & source & ";"
& "admin"
Consulta basica a una base de datos
Este ejemplo consiste en una búsqueda mediante DAO en una base de datos.
Para este ejemplo, hemos creado una base de datos "Ciudad.mdb" con una tabla
"Distritos" con dos campos "Ciudad" y "CodPostal".
Ejemplo:
Inserta el siguiente código:
Private Sub Form_Load()
Dim MiBase As Database
Dim MiConsulta As Recordset
Dim SQL As String
Set MiBase = OpenDataBase("C:\Ciudad.Mdb")
SQL = "Select * From Distritos Where CodPostal=28000"
Set MiConsulta = MiBase.OpenRecordset(SQL)
MsgBox "Ciudad: " & MiConsulta.Fields(0) & vbCrLf & "Código Postal: " &
MiConsulta.Fields(1)
End Sub
Copiar tablas entre bases de datos
Mediante la siguiente rutina podremos copiar todas las tablas de una base de
datos origen en una destino. Si las tablas ya existían en la base de datos de
destino se eliminan y se vuelven a crear con la misma estructura que tuvieran en
origen.
Las tablas de la base destino que no se encuentren en origen no se modifican.
Si el parámetro boCopiarDatos es true (valor por defecto) además de la
estructura se copian los datos de las tablas.
Sub CopiaTablas(strOrigen As String, strDestino As String, Optional
boCopiarDatos As Boolean = True)
Dim dbOrigen As Database, dbDestino As Database
Dim tdOrigen As TableDef, tdDestino As TableDef
Dim fdOrigen As Field, fdDestino As Field
Dim idOrigen As Index, idDestino As Index
Dim prOrigen As Property, prDestino As Properties
Dim i As Long
Screen.MousePointer = vbHourglass
'abrir origen y destino
Set dbOrigen = OpenDatabase(strOrigen, False)
Set dbDestino = OpenDatabase(strDestino, True)
'hay propiedades que no se pueden copiar como el value de los campos, etc
On Error Resume Next
'para cada tabla de origen
For Each tdOrigen In dbOrigen.TableDefs
If (tdOrigen.Attributes And (dbSystemObject Or dbHiddenObject)) = 0 Then
'si la tabla no es del sistema
'mirar si existe la tabla en destino
For Each tdDestino In dbDestino.TableDefs
If tdDestino.Name = tdOrigen.Name Then
'si existe la borro
dbDestino.TableDefs.Delete tdDestino.Name
Exit For
End If
Next
'creo la tabla en el destino
Set tdDestino = dbDestino.CreateTableDef(tdOrigen.Name,
tdOrigen.Attributes, tdOrigen.SourceTableName, tdOrigen.Connect)
'le añado los campos
For Each fdOrigen In tdOrigen.Fields
Set fdDestino = tdDestino.CreateField(fdOrigen.Name,
fdOrigen.Type, fdOrigen.Size)
'copio las propiedades del campo
For Each prOrigen In fdOrigen.Properties
fdDestino.Properties(prOrigen.Name) =
fdOrigen.Properties(prOrigen.Name)
Next
tdDestino.Fields.Append fdDestino
Next
'le añado los indices
For Each idOrigen In tdOrigen.Indexes
Set idDestino = tdDestino.CreateIndex(idOrigen.Name)
'añado los campos al índice
For Each fdOrigen In idOrigen.Fields
Set fdDestino = idDestino.CreateField(fdOrigen.Name)
idDestino.Fields.Append fdDestino
Next
'copio las propiedades del índice
For Each prOrigen In idDestino.Properties
idDestino.Properties(prOrigen.Name) =
idOrigen.Properties(prOrigen.Name)
Next
tdDestino.Indexes.Append idDestino
Next
dbDestino.TableDefs.Append tdDestino
'copio los datos de la tabla, si se solicitó
If boCopiarDatos Then dbOrigen.Execute ("INSERT INTO " +
tdDestino.Name + " IN '" + strDestino + "' SELECT * FROM " + tdDestino.Name)
End If
Next
'cerrar origen y destino
dbOrigen.Close
dbDestino.Close
Set dbOrigen = Nothing: Set dbDestino = Nothing
Set tdOrigen = Nothing: Set tdDestino = Nothing
Set fdOrigen = Nothing: Set fdDestino = Nothing
Set idOrigen = Nothing: Set idDestino = Nothing
Set prOrigen = Nothing: Set prDestino = Nothing
Screen.MousePointer = vbDefault
End Sub
Crear un índice en una propiedad personalizada
El siguiente artículo nos muestra cómo utilizar ActiveX Data Objects (ADO) para
crear una propiedad personalizada que está indizada.
La información de este artículo se refiere a:
Microsoft Exchange 2000 Server
Collaboration Data Objects 6.0 para Exchange 2000
Microsoft Visual Basic Enterprise Edition para Windows 6.0
ActiveX Data Objects (ADO) 2.5, 2.6
ActiveX Data Objects (ADO) 2.5, 2.6
En este ejemplo de Visual Basic se muestran las siguientes tareas:
Establece la definición de la propiedad
urn:schemas-microsoft-com:exch-data:isindexed como TRUE. (Tenga en cuenta que
esta configuración por sí sola no crea el índice.) El código que sigue al
comentario "Create the property definition in the schema folder for title"
indica cómo hacerlo.
Define una clase de contenido que incluye la propiedad personalizada. El código
que aparece bajo el comentario "Create the content class recipe" indica cómo
hacerlo.
Incluye dicha clase de contenido en la clase de contenido esperada de una
carpeta. Esta carpeta suele ser la carpeta de aplicación que contiene los
elementos en los que se encuentran los datos. El código que sigue al comentario
"Setting the expected content class for the application folder (myapp)" indica
cómo hacerlo.
Utiliza CREATE INDEX para crear índices en todas las propiedades definidas en la
clase de contenido esperada de la carpeta. (Esta función indiza todos los
elementos de una carpeta, en lugar de indizarlos individualmente.) El código que
sigue al comentario "Create indexes on all properties that are defined in the
folder's expected content class" indica cómo hacerlo.
Para ejecutar este ejemplo de código, siga estos pasos:
Cree una carpeta llamada Myapp en el subárbol de carpetas públicas
predeterminado y una subcarpeta de Myapp llamada Schema.
Establezca una referencia a la biblioteca de tipos Active DS y a la biblioteca
Microsoft ActiveX Data Objects 2.5.
Copie el siguiente código a un módulo de Visual Basic:
Const adModeReadWrite = 3
Const adFailIfNotExists = -1
Const adCreateNonCollection = 0
Private Sub Main()
Dim Conn
Dim Info
Dim InfoNT
Dim sFolderURL
Dim sSchemaFolderURL
Set Info = CreateObject("ADSystemInfo")
Set InfoNT = CreateObject("WinNTSystemInfo")
' Path of Virtual Root.
sVrootURL = "http://" & InfoNT.ComputerName & "." & Info.DomainDNSName &
"/public"
' Path to the application folder.
sFolderURL = sVrootURL & "/myapp"
' Path to the schema folder.
sSchemaFolderURL = sVrootURL & "/myapp/schema"
'This example creates an index on custom properties.
' The following property definitions are created:
' urn:schemas-domain-tld:title
' urn:schemas-domain-tld:ingredients
' These properties are used in the '
urn:schemas-domain-tld:content-classes:recipe content class.
' A URN scheme is used for the namespace: "urn:schemas-domain-tld:"
' where "tld" refers to "top-level domain".
Set Conn = CreateObject("ADODB.Connection")
Conn.Provider = "ExOLEDB.DataSource"
Conn.Open sSchemaFolderURL
Dim Rec
Set Rec = CreateObject("ADODB.Record")
' Create the property definition in the schema folder for title.
' This property will be the indexed property; note that
urn:schemas-microsoft-com:exch-data:isindexed is set to True.
Rec.Open sSchemaFolderURL & "/title", Conn, adModeReadWrite,
adCreateNonCollection
Set Flds = Rec.Fields
With Flds
.Item("DAV:contentclass") = "urn:content-classes:propertydef"
.Item("urn:schemas-microsoft-com:xml-data#name") =
"urn:schemas-domain-tld:title"
.Item("urn:schemas-microsoft-com:datatypes#type") = "string"
.Item("urn:schemas-microsoft-com:exch-data:ismultivalued") = False
.Item("urn:schemas-microsoft-com:exch-data:isindexed") = True
.Item("urn:schemas-microsoft-com:exch-data:isreadonly") = False
.Update
End With
Rec.Close
' Create the property definition in the schema folder for ingredients.
Rec.Open sSchemaFolderURL & "/ingredients", Conn, adModeReadWrite,
adCreateNonCollection
Set Flds = Rec.Fields
With Flds
.Item("DAV:contentclass") = "urn:content-classes:propertydef"
.Item("urn:schemas-microsoft-com:xml-data#name") =
"urn:schemas-domain-tld:ingredients"
.Item("urn:schemas-microsoft-com:datatypes#type") = "string"
.Item("urn:schemas-microsoft-com:exch-data:ismultivalued") = True
.Item("urn:schemas-microsoft-com:exch-data:isindexed") = False
.Item("urn:schemas-microsoft-com:exch-data:isreadonly") = False
.Update
End With
Rec.Close
' Create the content class recipe.
Rec.Open sSchemaFolderURL & "/ccdef-recipe", Conn, adModeReadWrite,
adCreateNonCollection
Set Flds = Rec.Fields
With Flds
' Name the content class.
.Item("urn:schemas-microsoft-com:xml-data#name").Value =
"urn:schemas-domain-tld:content-classes:recipe"
' The content class of the definition item.
.Item("DAV:contentclass") = "urn:content-classes:contentclassdef"
' The content classes it extends (inherits from).
.Item("urn:schemas-microsoft-com:xml-data#extends").Value =
Array("urn:content-classes:item")
' The additional properties that belong to this content class.
.Item("urn:schemas-microsoft-com:xml-data#element").Value =
Array("urn:schemas-domain-tld:title", "urn:schemas-domain-tld:ingredients")
.Update
End With
Rec.Close
Conn.Close
' Set properties on the application folder.
Conn.Open sFolderURL
Rec.Open sFolderURL, Conn, adModeReadWrite
Set Flds = Rec.Fields
With Flds
.Item("urn:schemas-microsoft-com:exch-data:schema-collection-ref") =
sSchemaFolderURL
'Setting the expected content class for the application folder (myapp)
.Item("urn:schemas-microsoft-com:exch-data:expected-content-class") = _
Array("urn:schemas-domain-tld:content-classes:recipe")
.Update
End With
Rec.Close
' Set baseschema property on the schema folder.
Rec.Open sSchemaFolderURL, Conn, adModeReadWrite
Set Flds = Rec.Fields
With Flds
.Item("urn:schemas-microsoft-com:exch-data:baseschema") =
Array(CStr("/public/non_ipm_subtree/Schema"))
.Update
End With
Rec.Close
' Create indexes on all properties that are defined in the folder's expected
content class.
Conn.Execute "CREATE INDEX * ON """ & sFolderURL & """ (*)"
' Create an item in the application folder using these custom properties.
Rec.Open sFolderURL & "/test1.txt", Conn, adModeReadWrite,
adCreateNonCollection Or adCreateOverwrite
Set Flds = Rec.Fields
With Flds
.Item("urn:schemas-domain-tld:title").Value = "Title of Recipe"
.Item("urn:schemas-domain-tld:ingredients").Value = Array("ingredient1",
"ingredient2", "ingredient3")
.Item("DAV:contentclass") =
"urn:schemas-domain-tld:content-classes:recipe"
.Update
End With
Rec.Close
Conn.Close
End Sub
Crear un nuevo campo en una bd de Access
Mediante la siguiente función podremos crear un nuevo campo en una base de datos
de Access.
Function Crea_Campo(cat As ADOX.Catalog, tdfActual As ADOX.Table, NombreCampo As
String, Tamaño As String, Nulo As String, TipoDato As String) As Boolean
Dim Col As New ADOX.Column
Dim Punto As Long
Dim Entero As Long
Dim Real As Long
On Error GoTo ErrorCrea_Campo
Crea_Campo = False
'PARENTCATALOG para tener acceso a una propiedad específica de un proveedor
Set Col.ParentCatalog = cat
'Nombre de la columna
Col.Name = NombreCampo
'Segun el tipo de dato creamos el campo
Select Case TipoDato
Case "Entero":
Select Case Acceso
Case "ACCESS"
If Col.Type <> adSmallInt Then Col.Type = adSmallInt
Col.DefinedSize = Val(Tamaño)
Case "SQL"
If Col.Type <> adSmallInt Then Col.Type = adSmallInt
Col.DefinedSize = Val(Tamaño)
End Select
Case "EnteroLargo":
Select Case Acceso
Case "ACCESS"
If Col.Type <> adInteger Then Col.Type = adInteger
Col.DefinedSize = Val(Tamaño)
Case "SQL"
If Col.Type <> adInteger Then Col.Type = adInteger
Col.DefinedSize = Val(Tamaño)
End Select
Case "Texto":
If Col.Type <> adWChar Then Col.Type = adWChar
Col.DefinedSize = Val(Tamaño)
Case "Memo":
Col.Type = adLongVarWChar
Case "Date":
Select Case Acceso
Case "ACCESS"
If Col.Type <> adDate Then Col.Type = adDate
Case "SQL"
If Col.Type <> adDBTimeStamp Then Col.Type = adDBTimeStamp
End Select
Case "Flotante":
Select Case Acceso
Case "ACCESS"
If Col.Type <> adDouble Then Col.Type = adDouble
Case "SQL"
Punto = InStr(1, Tamaño, ".")
Entero = Mid(Tamaño, 1, Punto - 1)
Real = Mid(Tamaño, Punto + 1, Len(Tamaño))
Col.Type = adNumeric
Col.NumericScale = CLng(Real)
Col.Precision = CLng(Entero)
Col.Properties("Default") = "0"
End Select
End Select
If Nulo = "NULL" Then
If Acceso = "ACCESS" Then
Col.Properties("Jet OLEDB:Allow Zero Length") = True
Else
Col.Properties("Nullable") = True
End If
Else
If Acceso = "ACCESS" Then
Col.Properties("Jet OLEDB:Allow Zero Length") = False
Else
Col.Properties("Nullable") = False
End If
End If
tdfActual.Columns.Append Col
Crea_Campo = True
Exit Function
ErrorCrea_Campo:
MuestraError, "Crea_Campo", Err, Error
End Function
Crear un usuario para una base de datos de Access
Mediante este código podremos crear un usuario para una base de datos de
Microsoft Access.
Const ADMIN_USERNAME = "Admin"
Const ADMIN_PASSWORD = "adminpass (or whatever)"
Const SHOWICON_STOP = 16
Const ADMIN_USERNAME = "Admin"
Const ADMIN_PASSWORD = "adminpass (or whatever)"
Const SHOWICON_STOP = 16
Function CreateNewUser% (ByVal username$, ByVal password$, ByVal PID$)
' Crea un nuevo usuario
' Username$ - nombre
' Password$ - password del usuario
' PID$ - PID del usuario
Dim NewUser As User
Dim admin_ws As WorkSpace
' Chequea el PID
If (Len(PID$) < 4 Or Len(PID$) > 20) Then
MsgBox "PID Inválido", SHOWICON_STOP
CreateNewUser% = True
Exit Function
End If
' Verifica que el usuario no existe
If (UserExist%(username$)) Then
CreateNewUser% = True
Exit Function
End If
' Abre un nuevo workspace y base de datos como Admin
dbEngine.Workspaces.Refresh
Set admin_ws = dbEngine.CreateWorkspace("TempWorkSpace", ADMIN_USER,
ADMIN_PASSWORD)
If (Err) Then
' Error al abrir el workspace
MsgBox "Password de Aministrador Inválida", SHOWICON_STOP
MsgBox "Error: " & Error$, SHOWICON_STOP, SystemName
CreateNewUser% = True
Exit Function
End If
On Error Resume Next
' Crea el nuevo usuario
Set NewUser = admin_ws.CreateUser(username$, PID$, password$)
If (Err) Then
MsgBox "Imposible crear el nuevo usuario", SHOWICON_STOP
MsgBox Error$, SHOWICON_STOP
Goto CreateNewUser_end
End If
' Añade el usuario a la lista de usuarios
admin_ws.Users.Append NewUser
' Añade al usuario al grupo "Users"
Set NewUser = admin_ws.CreateUser(username$)
admin_ws.Groups("Users").Users.Append NewUser
admin_ws.Users(username$).Groups.Refresh
admin_ws.Close
CreateNewUser% = False
CreateNewUser_end:
On Error Goto 0
End Function
Crear una base de datos de Access
A través del siguiente ejemplo, veremos cómo crear una base de datos de
Microsoft Access desde Visual Basic.
Public Function CreateDatabase(DBFullPath As String, InitialTable As String) As
Boolean
'Crea una base de datos con una tabla
Dim db As Database
Dim td As TableDef
Dim f As Field
On Error GoTo ErrorHandler
Set db = DBEngine.CreateDatabase(DBFullPath, dbLangGeneral)
Set td = db.CreateTableDef(IntialTable)
Set f = td.CreateField("ID", dbLong)
td.Fields.Append f
db.TableDefs.Append td
CreateDatabase = True
ErrorHandler:
If Not db Is Nothing Then db.Close
End Function
Crear una base de datos de Access(II)
Este es otro ejemplo más que nos enseña cómo crear una base de datos de Access
desde Visual Basic.
Function CreaBD_ACCESS(NombreBD as String) As Boolean
Dim cat As New ADOX.Catalog
On Error GoTo ErrorCreaBD_ACCESS
CreaBD_ACCESS = False
If Trim$(NombreBD)<>"" then
'Para conectar con BD Access 2000 usar el proveedor
Microsoft.Jet.OLEDB.4.0.
'Para conectar con Access 97 usar Microsoft.Jet.OLEDB.3.51
cat.Create ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & NombreDB &
".MDB")
End if
CreaBD_ACCESS = True
Exit Function
ErrorCreaBD_ACCESS:
MuestraError "CreaBD_ACCESS", Err, Error
End Function
Determina si un campo existe dentro de una tabla de una base de datos de Access
Mediante el siguiente ejemplo comprobaremos la existencia de un campo
determinado dentro de una tabla de una base de datos de Microsoft Access.
Public Function FieldExists(DatabaseName As String, TableName As String,
FieldName As String) As Boolean
Dim oDB As Database
Dim td As TableDef
Dim f As Field
On Error GoTo errorhandler
Set oDB = Workspaces(0).OpenDatabase(DatabaseName)
Set td = oDB.TableDefs(TableName)
On Error Resume Next
Set f = td.Fields(FieldName)
FieldExists = Err.Number = 0
oDB.Close
Exit Function
errorhandler:
If Not oDB Is Nothing Then oDB.Close
Err.Raise Err.Number
Exit Function
End Function
Determina si una tabla existe en una base de datos de Access
Mediante este ejemplo comprobaremos la existencia de una tabla determinada en
una base de datos de Microsoft Access.
Public Function TableExists(DatabaseName As String, TableName As String) As
Boolean
'DataBaseName = Nombre de la base de datos
'TableName = Nombre de la tabla a buscar
Dim oDB As Database, td As TableDef
On Error GoTo errorhandler
Set oDB = Workspaces(0).OpenDatabase(DatabaseName)
On Error Resume Next
Set td = oDB.TableDefs(TableName)
TableExists = Err.Number = 0
oDB.Close
exit function
errorhandler:
Err.Raise Err.Number
Exit Function
End function
Determinar si existen relaciones en una BD de Access
Mediante el ejemplo siguiente podremos averiguar si existen relaciones en una
base de datos de Access.
Function ExisteRelacion(cat As ADOX.Catalog, NombreTabla As String, NombreCampo
As String) As Boolean
'Esta funcion una relacion en la DB si la encuentra retorna TRUE
Dim RelacionBucle As New ADOX.Key
On Error GoTo ErrorExisteRelacion
ExisteRelacion = False
For Each RelacionBucle In cat.Tables.Item(NombreTabla).Keys
If RelacionBucle.Name = NombreCampo Then
ExisteRelacion = True
Exit For
End If
Next RelacionBucle
Exit Function
ErrorExisteRelacion:
MuestraError "ExisteRelacion", Err, Error
End Function
Determinar si un RecordSet está o no vacio
A través de este ejemplo comprobaremos si un Recordset de nuestra BD está vacío.
Ejemplo:
Inserta el siguiente código:
If Objeto_Recordset.BOF And Objeto_Recordset.EOF Then
MsgBox "NO hay datos en la consulta"
Else
MsgBox "Hay datos en la consulta."
End If
Encriptar campos en las tablas de Access
A través de este fenomenal ejemplo podremos encriptar los campos de una base de
datos de Microsoft Access.
Public encripta1 As String
Public desencri1 As String
Function ENCRIPTAR(valor As String)
Dim R As Integer
encripta1 = valor
R = Len(Trim(valor))
For I = 1 To R
Mid(encripta1, I, 1) = Chr(Asc(Mid(valor, I, 1)) - 1)
Next I
End Function
Function DESENCRIPTAR(valor As String)
Dim R As Integer
desencri1 = valor
R = Len(Trim(valor))
For I = 1 To R
Mid(desencri1, I, 1) = Chr(Asc(Mid(valor, I, 1)) + 1)
Next I
End Function
'Para encriptar
Call ENCRIPTAR(Text6.Text)
TABLA10.Fields!REMITENTE = encripta1
'Para desencriptar
Call DESENCRIPTAR(TABLA10.Fields!CARGO)
Text7.Text = desencri1
Establece una contraseña para una base de datos de Access
Mediante el siguiente ejemplo tendremos la oportunidad de establecer desde
Visual Basic una contraseña a una base de datos de Microsoft Access.
Public Function SetDatabasePassword(DBPath As String, newPassword As String) As
Boolean
'La base de datos debe estar inicialmente sin contraseña
If Dir(DBPath) = "" Then Exit Function
Dim db As DAO.Database
On Error Resume Next
Set db = OpenDatabase(DBPath, True)
If Err.Number <> 0 Then Exit Function
db.newPassword "", newPassword
SetDatabasePassword = Err.Number = 0
db.Close
End Function
Exportar datos Sql a un fichero Csv
El siguiente ejemplo nos enseña el método para poder exportar datos de un
fichero Sql a uno con extensión Csv.
Public Function CSVExport(db As DAO.Database, sSQL As String, sDest As String)
As Boolean
Dim record As Recordset
Dim nI As Long
Dim nJ As Long
Dim nFile As Integer
Dim sTmp As String
On Error GoTo Err_Handler
Set record = db.OpenRecordset(sSQL, DAO.dbOpenDynaset, DAO.dbReadOnly)
' Abre el fichero
nFile = FreeFile
Open sDest For Output As #nFile
' Exporta los campos
For nI = 0 To record.Fields.Count - 1
sTmp = "" & (record.Fields(nI).Name)
Write #nFile, sTmp;
Next
Write #nFile,
If record.RecordCount > 0 Then
record.MoveLast
record.MoveFirst
For nI = 1 To record.RecordCount
For nJ = 0 To record.Fields.Count - 1
sTmp = "" & (record.Fields(nJ))
Write #nFile, sTmp;
Next
Write #nFile,
record.MoveNext
Next
End If
Close #nFile
CSVExport = True
Exit Function
Err_Handler:
MsgBox ("Error: " & Err.Description)
CSVExport = False
End Function
Exporta la estructura de una tabla Oracle y su contenido a una base de datos de
Access
Este fenomenal ejemplo nos muestra un método para exportar la estructura y los
datos de una base de datos de Oracle a una base de datos de Microsoft Access.
Este ejemplo solo permite pasar datos numéricos y el tipo de datos "Varchar",
además de tener que estar ya la base de datos creada o no funcionará.
Para comenzar el ejemplo añada un botón a su formulario:
Private Sub Command1_Click()
Dim adoAccess As ADODB.Connection
Dim rstAccess As ADODB.Recordset
Dim adoOracle As ADODB.Connection
Dim rstOracle As ADODB.Recordset
Dim fldArray As Variant
Dim tblName(2) As String
Dim strSQL As String
Dim strAlter As String
Dim fld As ADODB.Field
Dim rowNumber As Integer
Dim fldNumber As Integer
Set adoAccess = New ADODB.Connection
Set rstAccess = New ADODB.Recordset
rstAccess.CursorLocation = adUseClient
Set adoOracle = New ADODB.Connection
Set rstOracle = New ADODB.Recordset
rstOracle.CursorLocation = adUseClient
tblName(0) = "TEST_TABLE1"
tblName(1) = "TEST_TABLE2"
'La base de datos debe estar creada sin tablas
adoAccess.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=C:\Program Files\Microsoft " & "Visual Studio\VB98\testmdb.mdb"
adoAccess.Open
'La base de datos de Oracle debe existir con el nombre de las tablas
adoOracle.ConnectionString = "Provider=MSDAORA.1;Data Source=your_source;" &
_
"User ID=my_id;Password=mypass"
adoOracle.Open
For a = 0 To UBound(tblName) - 1
'Crea la tabla Access sin columnas
adoAccess.Execute "create table " & tblName(a)
'Lee la información de una columna de una tabla Oracle
rstOracle.Open tblName(a), adoOracle, , , adCmdTableDirect
MsgBox tblName(a)
For Each fld In rstOracle.Fields
Select Case fld.Type
'Solo permite numérico y Varchar, en caso de necesitar más las
añadiríamos a continuación
Case adNumeric
'Modifica la tabla para añadir una columna numérica
strAlter = "alter table " & tblName(a) & " add column " &
fld.Name & " NUMBER"
adoAccess.Execute strAlter
Case adVarChar
'Modifica la tabla para añadir una columna de texto
strAlter = "alter table " & tblName(a) & " add column " &
fld.Name & " TEXT(" & fld.DefinedSize & ")"
adoAccess.Execute strAlter
End Select
Next fld
rstOracle.Close
'Selecciona todos los registros y los pone en un array
strSQL = "select * from " & tblName(a)
rstOracle.Open strSQL, adoOracle
fldArray = rstOracle.GetRows
'Abre la tabla Access
rstAccess.Open tblName(a), adoAccess, adOpenKeyset, adLockOptimistic,
adCmdTable
For rowNumber = 0 To UBound(fldArray, 2)
rstAccess.AddNew
For fldNumber = 0 To rstAccess.Fields.Count - 1
rstAccess(fldNumber) = fldArray(fldNumber, rowNumber)
Next fldNumber
rstAccess.Update
Next rowNumber
rstAccess.Close
rstOracle.Close
Next a
End Sub
Exportar una base de datos de Access a Html
A través del siguiente ejemplo, veremos como exportar los datos de la tabla de
una base de datos de Microsoft Access a un fichero Html.
Para ello añadiremos un botón y dos cajas de texto a un formulario.
Private Sub Command1_Click()
Dim fnum As Integer
Dim db As Database
Dim rs As Recordset
Dim num_fields As Integer
Dim i As Integer
Dim num_processed As Integer
On Error GoTo MiscError
' Abre el fichero de salida
fnum = FreeFile
Open Text2.Text For Output As fnum
' Escribe la cabecera HTML
Print #fnum, ""
Print #fnum, ""
Print #fnum, ""
Print #fnum, ""
Print #fnum, ""
Print #fnum, ""
Print #fnum, "My Title"
' Comienza la tabla HTML
Print #fnum, ""
' Abre la base de datos
Set db = OpenDatabase(Text1.Text)
' Ojo al SQL, haz los cambios necesarios
Set rs = db.OpenRecordset("SELECT * FROM Table1 ORDER BY ID")
Print #fnum, " " ' Comienza una columna
num_fields = rs.Fields.Count
For i = 0 To num_fields - 1
Print #fnum, " ";
Print #fnum, rs.Fields(i).Name;
Print #fnum, " "
Next i
Print #fnum, " "
Do While Not rs.EOF
num_processed = num_processed + 1
Print #fnum, " ";
For i = 0 To num_fields - 1
Print #fnum, " ";
Print #fnum, rs.Fields(i).Value;
Print #fnum, " "
Next i
Print #fnum, " ";
rs.MoveNext
Loop
' Cierra la tabla
Print #fnum, " "
Print #fnum, " "
Print #fnum, " " & Format$(num_processed) & " records displayed."
Print #fnum, ""
Print #fnum, ""
' Cierra el fichero y la base de datos
rs.Close
db.Close
Close fnum
MsgBox "Procesado " & Format$(num_processed) & " registros."
Exit Sub
MiscError:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End Sub
Private Sub Form_Load()
'Cambia a los nombres de tus ficheros
Text1.Text = "C:\TuBasedeDatos.mdb"
Text2.Text = "C:\TuFicheroHtml.htm"
End Sub
Exportar una o varias tablas a otro tipo de base de datos
Para exportar una o varias tablas a otro tipo de base de datos, escribir lo
siguiente.
Ejemplo:
Inicie un nuevo proyecto, añada un botón (nombre: Exportar).
Escriba el siguiente código para el formulario:
Private Sub Exportar_Click()
Dim db As Database
Set db = Workspaces(0).OpenDatabase(App.Path & "\Musica.mdb")
'db.execute "SELECT tabla.campos INTO [tipo base de
datos;DATABASE=path].[nombre del fichero a exportar] FROM [tabla o
tablas]
db.execute "SELECT * INTO [dBase III;DATABASE=D:\Mis Documentos].[Musica]
FROM [Disco]"
End Sub
Se exportará la tabla "Disco" en una base de datos con formato dBase III, y con
nombre Musica.dbf.
Exportar una tabla de Access a un fichero de Excel
El siguiente ejemplo nos enseña cómo exportar los datos de una base de datos de
Microsoft Access a una hoja de cálculo de Microsoft Excel.
Private Sub ExportOneTable()
'Deberemos referenciar DAO
Dim strExcelFile As String
Dim strWorksheet As String
Dim strDB As String
Dim strTable As String
Dim objDB As Database
'Cambiaremos estos datos de acuerdo a nuestras necesidades
strExcelFile = "C:\My Documents\MySpreadSheet.xls"
strWorksheet = "WorkSheet1"
strDB = "C:\My Documents\MyDatabase.mdb"
strTable = "MyTable"
Set objDB = OpenDatabase(strDB)
'Si el fichero excel existe, puedes borrarlo aqui
If Dir(strExcelFile) <> "" Then Kill strExcelFile
objDB.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & strExcelFile & "].[" &
strWorksheet & "] FROM " & "[" & strTable & "]"
objDB.Close
Set objDB = Nothing
End Sub
Extrae los nombres de todos los campos de la tabla de una Base de datos de
Access
A través de la siguiente rutina, podremos extraer los nombres de todos los
campos de cualquier tabla en una base de datos de Microsoft Access.
'dbPath = Nombre de la base de datos con su trayectoria
'TableName = Nombre de la Tabla
Public Function FieldNames(dbPath As String, TableName As String) As Collection
Dim oCol As Collection
Dim db As DAO.Database
Dim oTD As DAO.TableDef
Dim lCount As Long, lCtr As Long
Dim f As DAO.Field
On Error GoTo errorhandler
Set db = workspaces(0).opendatabase(dbPath)
Set oTD = db.TableDefs(TableName)
Set oCol = New Collection
With oTD
lCount = .Fields.Count
For lCtr = 0 To lCount - 1
oCol.Add .Fields(lCtr).Name
Next
End With
db.Close
Set FieldNames = oCol
Exit Function
errorhandler:
On Error Resume Next
If Not db Is Nothing Then db.Close
Set FieldNames = Nothing
Exit Function
End Function
Grabar una imagen en una BD de Access
Mediante el ejemplo siguiente podremos grabar una imagen determinada en una base
de datos de Access.
Sub GrabaImagenEnBD(f As adodb.Field, NombreImagen As String)
Dim Fichero As Integer
Dim LongitudFichero As Long
Const TamañoBuffer = 1024
Dim TamañoMinimo As Long
Dim Bloques As Long
Dim x() As Byte
Dim i As Long
On Error GoTo ErrorGrabaImagenEnBD
Fichero = FreeFile
Open NombreImagen For Binary Access Read As Fichero
LongitudFichero = LOF(Fichero)
Bloques = Int(LongitudFichero / TamañoBuffer)
TamañoMinimo = LongitudFichero Mod TamañoBuffer
ReDim x(TamañoMinimo)
Get Fichero, , x()
f.AppendChunk x()
ReDim x(TamañoBuffer)
For i = 1 To Bloques
Get Fichero, , x()
f.AppendChunk x()
Next
Close Fichero
Exit Sub
ErrorGrabaImagenEnBD:
MuestraError "GrabaImagenEnBD", Err, Error
End Sub
Introducir fotos en una BD sin DataControl
Para introducir fotografías en una base de datos sin usar el control Data,
bastará con ejecutar las siguientes líneas de código.
Tenemos un recordset llamado MiRecordSet con un campo tipo OLE llamado MiCampo y
un picture box llamado Picture1.
Para leer la imagen y mostrarla en el picture:
LeerBinary MiRecordSet!MiCampo, Picture1
Para guardar la imagen del picture en el campo:
GuardarBinary MiRecordSet!MiCampo, Picture1
Las funciones son:
Option Explicit
Dim DataFile As Integer
Dim Chunk() As Byte
Const conChunkSize As Integer = 16384
Public Sub LeerBinary(campoBinary As Field, unPicture As PictureBox)
'Leer la imagen del campo de la base y asignarlo al Picture
Dim lngCompensación As Long
Dim lngTamañoTotal As Long
'Se usa un fichero temporal para guardar la imagen
DataFile = FreeFile
Open "pictemp" For Binary Access Write As DataFile
lngTamañoTotal = campoBinary.FieldSize
Do While lngCompensación < lngTamañoTotal
Chunk() = campoBinary.GetChunk(lngCompensación, conChunkSize)
Put DataFile, , Chunk()
lngCompensación = lngCompensación + conChunkSize
Loop
Close DataFile
'Ahora se carga esa imagen en el control
unPicture.Picture = LoadPicture("pictemp")
'Ya no necesitamos el fichero, así que borrarlo
On Local Error Resume Next
If Len(Dir$("pictemp")) Then
Kill "pictemp"
End If
Err = 0
End Sub
Public Sub GuardarBinary(campoBinary As Field, unPicture As PictureBox)
'Guardar el contenido del Picture en el campo de la base
Dim i As Integer
Dim Fragment As Integer, Fl As Long, Chunks As Integer
'NOTA:
' El recordset debe estar preparado para Editar o Añadir
'Guardar el contenido del picture en un fichero temporal
SavePicture unPicture.Picture, "pictemp"
'Leer el fichero y guardarlo en el campo
DataFile = FreeFile
Open "pictemp" For Binary Access Read As DataFile
Fl = LOF(DataFile) ' Longitud de los datos en el archivo
If Fl = 0 Then Close DataFile: Exit Sub
Chunks = Fl \ conChunkSize
Fragment = Fl Mod conChunkSize
ReDim Chunk(Fragment)
Get DataFile, , Chunk()
campoBinary.AppendChunk Chunk()
ReDim Chunk(conChunkSize)
For i = 1 To Chunks
Get DataFile, , Chunk()
campoBinary.AppendChunk Chunk()
Next i
Close DataFile
'Ya no necesitamos el fichero, así que borrarlo
On Local Error Resume Next
If Len(Dir$("pictemp")) Then
Kill "pictemp"
End If
Err = 0
End Sub
Llamar a un programa del AS/400 para recuperar un registro Enviado por Rodolfo
del Peru
Mediante esta rutina podremos llamar a un programa del AS/400 para recuperar un
registro.
Sub Recupera_Cliente()
Dim Rcds As Variant
Dim Parms As Variant
Dim cm As New ADODB.Command
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Set cm.ActiveConnection = cnAS400
'LibreriaProg es el nombre de la libreria en AS/400 donde reside el programa
cm.CommandText = "{call LibreriaProg.PROGAS400(?)}"
cm.Prepared = True
cm.Parameters(0).Direction = adParamInput
Parms = Array(Trim(txtCliente))
Set rs = cm.Execute(Rcds, Parms, adCmdText)
With rs
If .EOF Then
MsgBox "Cliente no existe", vbExclamation, Me.Caption
txtCliente.SetFocus
txtNombre = ""
txtDireccion1 = ""
Else
txtNombre = .Fields(2).Value
txtDireccion1 = .Fields(3).Value
End If
End With
rs.Close
End Sub
En el AS/400 el programa de tipo SQLRPG seria asi:
C *ENTRY PLIST
C PARM PCLI 7
C/EXEC SQL INCLUDE SQLCA
C/END-EXEC
C/EXEC SQL DECLARE C1 CURSOR FOR
c+ SELECT * FROM library/Archivo WHERE
C+ CODCLI =: PCLI
C/END-EXEC
C/EXEC SQL OPEN C1
C/END-EXEC
C/EXEC SQL SET RESULT SETS CURSOR C1
C/END-EXEC
C SETON LR
Finalmente, el enlace entre el SQL del AS/400 y la PC esta dado por un
Procedimiento almacenado, asi:
'LibreriaProg es el nombre de la libreria en AS/400 donde reside el programa
create procedure LibreriaProg/PROGAS400(in CODIGO CHAR(7)) result set 1 external
name LibreriaProg/PROGAS400 language RPG general variant
Este procedimiento se crea entrando al AS/400 y dando el comando STRSQL.
Modificar la contraseña de una base de datos
A través del ejemplo siguiente, tendremos la oportunidad de modificar la
contraseña de una base de datos existente.
Public Function ChangeDatabasePassword(DBPath As String, newPassword As String,
oldPassWord As String) As Boolean
'Ejemplo ChangeDatabasePassword("C:\Ejemplo.mdb", "PassNueva",
"PassAntigua")
If Dir(DBPath) = "" Then Exit Function
Dim db As DAO.Database
On Error Resume Next
Set db = OpenDatabase(DBPath, True, False, ";pwd=" & oldPassWord)
If Err.Number <> 0 Then Exit Function
db.newPassword oldPassWord, newPassword
ChangeDatabasePassword = Err.Number = 0
db.Close
End Function
Modulo de consulta dinamica con agrupamientos
Con este módulo obtendremos la consulta de agrupamiento observando una serie de
criterios que rellenaremos por el formulario. En este caso buscaremos atendiendo
a la fecha (desde-hasta) y al departamento. Si la fecha o el departamento
estuviesen vacíos, se cogerán todos los valores. Los agrupamientos (en este caso
según meses, días o años) se colocarán fijos en un cuadro de lista y agrupamos
atendiendo a la elección del agrupamiento.
El código del ejemplo:
Private Sub Command1_Click ()
Dim Consref As QueryDef, Base1 As Database, Consulta2 As QueryDef
Set Base1 = DbEngine.Workspaces(0).Databases(0)
Base1.QueryDefs.Delete "Agrupacion"
Base1.QueryDefs.Delete "Agrupacion del dia"
Set Consref = Base1.CreateQueryDef()
contador = 0
Misql = "TRANSFORM SUM([" & [Campo4] & "]) As Total
SELECT Consulta1.Referencia,SUM([" & [Campo4] & "]) As
[Resumen de la fila] "
Misql = Misql & "FROM Consulta1 "
'Aqui filtramos los registros por fechas.
'Si Ambos filtros estan vacios, cogemos todos los valores.
'Si uno esta relleno, actuamos en consecuencia
If Not (IsNull([Campo18])) Then
If Not (IsNull([Campo20])) Then
Condicion = " WHERE (movimientos.Fecha Between #" &
Format([Campo18], "mm/dd/yy") & "# AND #" &
Format([Campo20], "mm/dd/yy") & "#)"
Else
Condicion = " WHERE (movimientos.Fecha > #" &
Format([Campo18], "mm/dd/yy") & "#)"
End If
Else
If Not (IsNull([Campo20])) Then
Condicion = " WHERE (movimientos.Fecha < #" &
Format([Campo20], "mm/dd/yy") & "#)"
Else
contador = 1
End If
End If
'Aqui colocamos la segunda opcion de filtrado,
que en este caso es por departamento. Si esta en blanco cogemos todos
los valores posibles
If Not (IsNull([Campo15])) Then
If contador = 1 Then
Condicion = " WHERE Nombre LIKE " & Chr$(34) & [Campo15] &
Chr$(34) & " "
Else
Condicion = Condicion & " AND (Nombre LIKE " & Chr$(34) &
[Campo15] & Chr$(34) & ") "
End If
End If
Misql = Misql & Condicion & "GROUP BY Consulta1.Referencia "
'Aqui agrupamos por fechas pero basandonos
en un cuadro de lista con periodos especificos
If [Campo2] = "Por mes" Then
Misql = Misql & " PIVOT Format([Fecha]," & Chr$(34) &
"mm/yy" & Chr$(34) & ");"
End If
If [Campo2] = "Por año" Then
Misql = Misql & " PIVOT Year([Fecha]);"
End If
If [Campo2] = "Por dia" Then
Misql = Misql & " PIVOT Fecha;"
End If
Consref.Name = "Agrupacion"
Consref.SQL = Misql
Base1.QueryDefs.Append Consref
Misql = "SELECT Agrupación.* From [Agrupacion]
ORDER BY [Resumen de la fila] DESC"
Set Consulta2 = Base1.CreateQueryDef()
Consulta2.SQL = Misql
Consulta2.Name = "Agrupacion del dia"
Base1.QueryDefs.Append Consulta2
A = MsgBox("Consulta terminada", 64)
Base1.Close
End Sub
Diccionario de datos
[Campo18]= Casilla de Texto. Seleccionamos la fecha desde.
[Campo20]= Casilla de Texto. Seleccionamos la fecha hasta.
[Campo15]= Cuadro de lista. Seleccionamos el departamento. El origen viene
determinado por una consulta en la cual seleccionamos los departamentos.
[Campo2]= Cuadro de lista. Seleccionamos el tipo de agrupamiento. En este
caso es por mes, día, año. Estos valores son fijos.
Modulo standard de busquedas dinamicas
Con el módulo de búsquedas dinámicas generaremos una consulta a partir de una
serie de datos a través de los cuales deseamos realizar dicha consulta. Este
módulo se apoya en un formulario independiente (no se apoya en ninguna tabla),
en el cual se han colocado una serie de controles, normalmente cuadros de texto
y cuadros de lista combinados, en los cuales colocaremos las opciones o
parámetros sobre los cuales se realizará la búsqueda. Las razones para la
utilización de este módulo son:
No se necesita conocer sobre qué tablas hay que hacer la consulta.
No se necesita conocer cómo crear consultas.
No hace falta tener una consulta creada para cada caso concreto.
Búsquedas más rápidas y flexibles: Se pueden rellenar todos, alguno o ninguno de
los campos del formulario de la búsqueda.
Permite una impresión de la misma, realizar un gráfico o cambiar el origen de un
formulario/informe a dicha consulta.
El código del ejemplo:
Option Compare Database 'Usar orden de base de datos en comparaciones de cadenas
Private Sub Command_Click ()
Dim Mientrada As String, Misalida As String, Micriterio As String,
Origen As String, Contador1 As Integer
Dim Tabla As Recordset, Basedatos As Database, Tabla2 As Recordset
Set Basedatos = DbEngine.Workspaces(0).Databases(0)
Set Tabla = Basedatos.OpenRecordset("Movimientos", DB_OPEN_DYNASET)
Set Tabla2 = Basedatos.OpenRecordset("embalajes", DB_OPEN_DYNASET)
Contador1 = 0
Mientrada = "SELECT Movimientos.Cantidad, embalajes.articulo,
Movimientos.Fecha "
Mientrada = Mientrada & "FROM embalajes INNER JOIN Movimientos
ON embalajes.articulo = Movimientos.Articulo"
Misalida = Mientrada
Mientrada = Mientrada & " WHERE ((Movimientos.Cantidad > 0)"
Misalida = Misalida & " WHERE ((Movimientos.Cantidad < 0)"
If IsNull([Campo0]) Then
Micriterio = ""
Else
Micriterio = " AND (embalajes.articulo = [Campo0])"
End If
If [Campo2] <> "" Then
If [Campo4] <> "" Then
Micriterio = Micriterio & " AND
(Movimientos.Fecha Between [Campo2] AND [Campo4])"
Else
Micriterio = Micriterio & " AND
(Movimientos.Fecha >= [Campo2] )"
End If
Else
If [Campo4] <> "" Then
Micriterio = Micriterio & " AND
(Movimientos.Fecha <= [Campo4] )"
End If
End If
If [Campo0] = "" And [Campo2] = "" And [Campo4] = "" Then
Micriterio = ")"
Else
Micriterio = Micriterio & ") ORDER BY Movimientos.Fecha"
End If
MiOrigen = Mientrada & Micriterio
Me![Incrustado10].Form.RecordSource = MiOrigen
Me![Incrustado12].Form.RecordSource = Misalida & Micriterio
End Sub
Es interesante observar como varian las instrucciones y
parámetros de la consulta dependiendo del valor de los controles
y como se usa el contenido de los mismos para utilizarlos en la
instrucción SQL. Al final vemos como dicha instrucción SQL
se utiliza para la propiedad OrigenDelRegistro (RecordSource) de dos
subformularios que tiene el formulario de búsqueda.
Si quisiéramos añadir dicha consulta a las consultas de
la base de datos entonces haríamos lo siguiente:
Dim Consref As QueryDef, Base1 As Database, Consulta2 As QueryDef
Set Base1 = Dbengine.Workspaces(0).Databases(0)
…….
Set Consulta2 = Base1.CreateQueryDef()
Consulta2.SQL = "SELECT Temporal1.* From [Temporal1]"
If [Campo15] = -1 Then
Consulta2.SQL = Consulta2.SQL & " ORDER BY [Resumen de la fila] DESC"
End If
Consulta2.Name = "Temporal"
Base1.Querydefs.Append Consulta2
Obtener los nombres de las tablas de una bd de Access
Mediante el siguiente ejemplo podremos obtener los nombres de las tablas de una
bd de Access, tanto si trabajamos con ADO como con DAO.
Si trabajas en DAO:
Dim db as Database
'Abres la base de datos
Dim tdf as TableDef
For each tdf in db.TableDefs
'Agrega el nombre al Listbox o a otro control usando la propiedad tdf.Name
Next tdf
Si trabajas en ADO:
Debes utilizar el ADOX. Para esto agrega la referencia a Microsoft ADO Ext. 2.5
for Dll and Security.
Dim cn as new ADODB.Connection
Dim ct as new ADOX.Catalog
Dim tb as new ADOX.Table
'Abres la conexión y el Catalog
cn.open 'Connectiontring'
Set ct.ActiveConnection = cn
For each tb in ct.Tables
'Agrega el nombre al Listbox o a otro control usando la propiedad tb.Name
Next tb
Procedimiento para cargar las tablas de una Base de Datos en un ListBox
Estos dos ejemplos nos permiten cargar el contenido de las tablas de una base de
datos en un ListBox.
Inserte un ListBox en un proyecto. Copie una de las siguientes rutinas de código
en un módulo y llámelo desde el formulario.
Suponemos que el fichero de la base de datos se llama Agentel.mdb :
Los dos procedimientos son formas de hacerlo diferentes. El segundo
procedimiento es una forma más depurada aún de hacerlo.
Ejemplo:
1 Procedimiento
Public Sub CargarTablas()
Dim I As Integer
' Declarada en el apartado Declaraciones : BD as Database
Set BD = Workspaces(0).OpenDatabase("Agentel.Mdb")
' Limpiamos el control ListBox donde cargamos las tablas
List1.Clear
With BD
For I = 0 To .TableDefs.Count - 1
If Not Left(.TableDefs(I).Name, 4) = "MSys" Then
List1.AddItem .TableDefs(I).Name
End If
Next I
End With
End Sub
2 Procedimiento
Public Sub CargarTablas()
Dim I As Integer
' Declarada en el apartado Declaraciones : BD as Database
Set BD = Workspaces(0).OpenDatabase("Agentel.Mdb")
' Limpiamos el control ListBox donde cargamos las tablas
List1.Clear
With BD
For I = 0 To .TableDefs.Count - 1
' Cargar sólo las tablas que no son del sistema
If .Tabledef.Attributes = 0 Then
List1.AddItem .TableDefs(I).Name
End If
Next I
End With
End Sub
Realizar una consulta por Passthrough en RDO
La técnica del "passthrough" permite enviar una consulta SQL a una base de datos
sin necesidad de pasar por el administrador de ODBC. La ventaja principal de
utilizar "passthrough" es obtener un mejor rendimiento ya que la consulta es
procesada por menos componentes. Además, en ciertas ocasiones es necesario
utilizar esta técnica cuando se utilizan sentencias SQL que no son estándar y
son propietarias de una base de datos concreta.
El último parámetro de la instrucción "OpenResulset" permite pasar una consulta
por "passthrough" especificando la constante "rdExecDirect".
El siguiente ejemplo muestra cómo ejecutar una consulta por "passthrough":
Dim cn as New rdoConnection
Dim rst as rdoResultset
cn.Connect="uid=sa;pwd=;server=SERVIDOR;_
driver=" & "{SQLServer};database=pubs;DSN=' ';"
cn.EstablishConnection rdDriverNoPrompt
Set rst=cn.OpenResultset("SELECT * FROM_
authors", rdOpenKeyset,rdConcurReadOnly, rdExecDirect)
Recuperar una imagen grabada en una BD de Access
Este ejemplo nos muestra cómo recuperar una imagen previamente grabada en una
base de datos de Access.
Sub CogeImagenDeBD(f As adodb.Field, NombreImagen As String)
Dim Fichero As Integer
Const TamañoBuffer = 1024
Dim TamañoMinimo As Long
Dim Bloques As Long
Dim x() As Byte
Dim i As Long
On Error GoTo ErrorCogeImagenDeBD
Fichero = FreeFile
Open NombreImagen For Binary Access Write As Fichero
Bloques = Int(f.ActualSize / TamañoBuffer)
TamañoMinimo = f.ActualSize Mod TamañoBuffer
x() = f.GetChunk(TamañoMinimo)
Put Fichero, , x()
For i = 1 To Bloques
x() = f.GetChunk(TamañoBuffer)
Put Fichero, , x()
Next
Close Fichero
Exit Sub
ErrorCogeImagenDeBD:
MuestraError "CogeImagenDeBD", Err, Error
End Function
Renombra una tabla de una base de datos de Access
Mediante la siguiente rutina, podremos renombrar una tabla cualquiera de una
base de datos de Microsoft Access.
Public Function RenameTable(DatabaseName As String, ByVal OldTableName As
String, _
ByVal NewTableName As String) As Boolean
On Error GoTo errorhandler
Dim oDB As DAO.Database
Dim td As DAO.TableDef
Set oDB = Workspaces(0).OpenDatabase(DatabaseName)
On Error GoTo errorhandler
If Not TableExists(oDB, OldTableName) Then GoTo errorhandler
If TableExists(oDB, NewTableName) Then GoTo errorhandler
'Crea el objeto tabla
Set td = oDB.TableDefs(OldTableName)
td.Name = NewTableName
oDB.TableDefs.Refresh
oDB.Close
RenameTable = True
Exit Function
errorhandler:
If Not oDB Is Nothing Then oDB.Close
Set td = Nothing
End Function
Traspasar la información de una base de datos a un Combobox
Si quisiéramos pasar el contenido de un fichero de Base de Datos a un control
ComboBox, podríamos hacerlo de la siguiente manera:
Ejemplo:
Inicie un nuevo proyecto en Visual Basic, añada un botón y escriba este código:
Private Sub Command1_Click()
Dim DB As Database
Dim SS As Snapshot
Set DB = OpenDatabase("C:\BASE.MDB")
Set SS = DB.CreateSnapshot("Infor")
Do Until SS.EOF
If Len(SS(0)) = 1 Then
Combo1.AddItem SS(0) & " " & SS(1)
Else
Combo1.AddItem SS(0) & " " & SS(1)
End If
SS.MoveNext
Loop
End Sub
Uso del control MSFlexGrid con ADO
El siguiente ejemplo, demuestra como conectar una base de datos con ADO a un
control MSFlexGrid.
Ejemplo:
Inserte dos botones que nos servirán para conectar y desconectar la base de
datos y acceder a los datos mediante ADO.
El programa abre una tabla denominada "Citas".
Modifique los datos que considere oportunos.
La información se mostrará en 25 campos o columnas dentro del control
MSFlexGrid.
Escriba la siguiente función:
Dim Cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String
Dim sOut As String
Private Sub Command1_Click()
Dim ii As Long
Dim oo As Integer
If Cn.State = adStateOpen Then
MsgBox "ADO Connection Successful!"
End If
sSQL = "Select * from Citas"
rs.Open sSQL, Cn, adOpenDynamic
sOut = ""
ii = 0
While rs.EOF <> True
DBGrid1.Rows = ii + 1
iii = 1
For oo = 0 To 24
DBGrid1.TextMatrix(ii, oo) = rs.Fields(oo)
Next oo
ii = ii + 1
rs.MoveNext
Wend
End Sub
Private Sub Command2_Click()
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
Unload Me
End Sub
Private Sub Form_Load()
Set Cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Cn.ConnectionString = "DSN=TESTRCH01;UID=ADOTRY;PWD=ADOTRY;"
Cn.ConnectionTimeout = 100
Cn.Open
End Sub
Principal
(
geocities.com/es/ensolva/Descargas) (
geocities.com/es/ensolva) (
geocities.com/es)