************************************
*Recopilado por el Buho de la Web:
*http://www.terra.es/personal2/sfortiz/
************************************




Conectar con SQL Server
=======================
 
Function Conecta_SQL(Conexion As ADODB.Connection, AperturaExclusiva As Boolean) As Boolean

On Error GoTo ErrorConecta_SQL
Conecta_SQL = False
Set Conexion = New ADODB.Connection
Conexion.CommandTimeout = TiempoEsperaConexion
If AperturaExclusiva Then

    'Se abrira la conexion en modo exclusibo

    Conexion.Mode = adModeShareDenyNone

    Conexion.IsolationLevel = adXactIsolated

End If

Cnct = "Provider=SQLOLEDB.1";Data Source=" & SERVER & ";Initial Catalog="  & DATABASE _

            &  ";User Id=" & USUARIO & ";Password="  & CLAVE & ";"

  

Conexion.Open Cnct
Call EjecutaSQL(Conexion, " SET CONCAT_NULL_YIELDS_NULL OFF ", Tipo)
Conecta_SQL = True
Exit Function
ErrorConecta_SQL:

  MuestraError  "Conecta_SQL", Err, Error

End Function


 
Conectar con MS Access
======================
 
Function Conecta_ACCESS(Conexion As ADODB.Connection, AperturaExclusiva As Boolean) As Boolean

Dim strCnn As String

  

On Error GoTo errorConecta_ACCESS

Conecta_ACCESS = False

NombreDB = "C.\NombreBD.MDB"

If Dir(NombreDB) <> "" Then

    ' Abre una conexión.

    Set Conexion = New ADODB.Connection

    '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

    Conexion.PROVIDER = Microsoft.Jet.OLEDB.4.0

    If AperturaExclusiva Then

       'Se abrira la conexion en modo exclusibo

        Conexion.Mode = adModeShareExclusive

    Else

        Conexion.Mode = adModeUnknown

    End If

    Conexion.Open NombreDB, "admin", ""

    Conecta_ACCESS = True

Else

    MsgBox "Base de datos no activa.", vbExclamation, "Atención"

End If

  

Exit Function

errorConecta_ACCESS:

    If Err = 3343 Or Err = -2147467259 Then

        MsgBox "Base de datos dañada.", vbCritical, "Base de Datos"

        Conecta_ACCESS = True

    Else

        MuestraError "Conecta_ACCESS", Err, Error

    End If 

End Function

 
 
Crea Recordset ADO
==================
 
Function CreaRecordset(cnn As ADODB.Connection, rsAdo As ADODB.Recordset, SQL As String) As Boolean

On Error GoTo ErrorCreaData

CreaRecordset = False

  

Set rsAdo = New ADODB.Recordset

rsAdo.CursorType = adOpenKeyset

rsAdo.CursorLocation = adUseClient

'Si queremos actualizar datos desde nuestra aplicación y se vean en la BD debeis poner rsAdo.LockType = adLockOptimistic

rsAdo.LockType = adLockOptimistic

rsAdo.Open SQL, cnn, , , adCmdText

 

CreaRecordset = True

Exit Function

ErrorCreaData:

   MuestraError "CreaData", Err, Error

End Function
 
Crea  AdoControl
================
 
Sub CreaAdo(Conexion As ADODB.Connection, rsAdo As Adodc, SQL As String)

Dim rs As ADODB.Recordset

On Error GoTo ErrorCreaADO 

 

If CreaRecordset(Conexion, rs, SQL) Then

    Set rsAdo.Recordset = rs

End If 

 

Exit Sub

ErrorCreaADO:

   MuestraError "CreaADO", Err, Error

End Sub