Acceso a Bases de datos SQL Server...

Fecha: 04/May/98
Autor: Quique

Acceso a una Base de datos SQL Server utilizando el metodo OpenConnection para establecer una conexi�n con un origen de datos de un espacion de trabajo ODBCDirect.
Ejecuta consultas de SQL directamente el Server, creando procedimientos almacenados, tablas temporales y borrandolos antes de cerrar la conexi�n.
El modulo es llamado desde un formulario, pero si se quiere se pueden quitar todas las referencias al formulario y el modulo se ejecutaria sin mensajes.
En este ejemplo creo una tabla en SQL Server y la traspaso a ACCESS 97, pero se podria modificar para que imprimiera un informe en CR, por ejemplo.

Sub Procedimiento_SQL(CdAnio As String)
    Dim wsODBC As Workspace, conODBC As Connection, bd As Database, rs As Recordset, qdfTemp As QueryDef, tdf As TableDef
    Dim SQL_1 As String, SQL_2 As String, MiSQL As String, i As Integer
    
    DoCmd.SetWarnings False  ' Desactiva la presentaci�n de mensajes del sistema 
    DoCmd.Hourglass True 'lleva a cabo la acci�n RelojDeArena
    
    Forms!T_SQL!Lit_Estado.Caption = "Conectando a Base de Datos"
    DoEvents
    Set wsODBC = CreateWorkspace("", <NOMBRE DE USUARIO>,<PASSWORD>, dbUseODBC)
'Crea un nuevo espacio de trabajo Workspace de ODBCDirect, al establecer  dbUseODBC el motor de base de datos Microsoft Jet no se cargar� en memoria y toda actividad se producir� con el origen de datos ODBC identificado el en objeto Connection.

    Set conODBC = wsODBC.OpenConnection("NuevaConexion", dbDriverNoPrompt, True, "ODBC;DATABASE=<NOMBRE BASE DATOS>;UID=<NOMBRE USUARIO>;PWD=<PASSWORD>;DSN=<CREADO EN ODBC32>")
' Establece una conexi�n con origen de datos en un espacio de trabajo ODBCDirect. DbDriverNoPrompt utiliza la cadena de conexi�n proporcionada en <nombreBaseDatos> , si no se proporciona suficiente informacion produce un error en tiempo de ejecucion, cambiar a dbDriverPrompt si se desea que el administrador del controlador muestre el cuadro de dialogo.
    
' La siguiente sentencia prepara la sesion en el servidor para una consulta "dirty reads", que no se bloquee ninguna tabla de las que se usen.
    Set qdfTemp = conODBC.CreateQueryDef("") ' los objetos son siempre temporales en ODBCDirect
    With qdfTemp
        .Prepare = dbQUnprepare
        .SQL = "SET TRANSACTION ISOLATION LEVEL READ UNCOMMITTED"
        .ODBCTimeout = 120
        .Execute
    End With
    
'Verificamos que no existe el procedimiento alamcenado en el servidor
    Set qdfTemp = conODBC.CreateQueryDef("")
    MiSQL = "if exists (select * from sysobjects where id = object_id('proced') and sysstat & 0xf = 4)" & _
      " drop procedure proced"
    With qdfTemp
        .Prepare = dbQUnprepare
        .SQL = MiSQL
        .ODBCTimeout = 120
        .Execute
    End With
    
'Verificamos que no existe la tabla auxiliar que creamos como almacenamiento temporal
    Set qdfTemp = conODBC.CreateQueryDef("")
    MiSQL = "if exists (select * from sysobjects where id = object_id('Tmp_ Dist') and sysstat & 0xf = 3)" & _
      " drop table Tmp_Dist"
    With qdfTemp
        .Prepare = dbQUnprepare
        .SQL = MiSQL
        .ODBCTimeout = 120
        .Execute
    End With
 
' Aqu� esta el procedimiento almacenado en cuestion. Se pasa como parametro el a�o, y se utilizan transaccciones con el fin de no bloquear la tempdb.
    Set qdfTemp = conODBC.CreateQueryDef("")
    SQL_1 = "CREATE PROCEDURE Proced (@CdAnio char(4)) AS " & _
            "begin tran " & _
                "SELECT anio_factura AS anio, mes_factura AS mes, id_cliente, id_producto AS id_producto, id_envase AS id_envase, " & _
                    "SUM(kgs) AS Kilos " & _
                    "INTO #tmp_sog " & _
                    "FROM Venta_Direc V " & _
                    "WHERE anio_factura = @CdAnio AND " & _
                    "GROUP BY anio_factura, mes_factura, id_cliente, id_producto, id_envase " & _
            "if @@error != 0 " & _
                "rollback " & _
            "commit tran "
    SQL_2 = "begin tran " & _
                "SELECT id_cliente AS id_Distribuidor, anio, mes, T.id_producto, id_envase, kilos " & _
                    "INTO Tmp_Dist " & _
                    "FROM #tmp_sog T, producto P, familia_nueva F, especialidad E, sublinea S " & _
                    "WHERE T.id_producto = P.id_producto AND " & _
                    "P.id_familia_nueva = F.id_familia_nueva AND " & _
                    "F.id_especialidad = E.id_especialidad AND " & _
                    "E.id_sublinea = S.id_sublinea AND " & _
                    "S.id_linea_nueva IN ('A','I','G','P','D') " & _
                    "ORDER BY id_Distribuidor, anio, mes, T.id_producto, id_envase " & _
            " drop table #tmp_sog " & _
            "if @@error != 0 " & _
                "rollback " & _
            "commit tran "
    MiSQL = SQL_1 + SQL_2
    
' Pasa el procedimiento almacenado a SQL Server
    Forms!T_COMPRAS!Lit_Estado.Caption = "Procesando registros de Base de datos"
    DoEvents
    With qdfTemp
        .Prepare = dbQPrepare
        .SQL = MiSQL
        .ODBCTimeout = 120
        .Execute
    End With
    
'Ojo. Aqu� se utiliza un formulario, desde el cual se llama al modulo.
' Aqu� es donde se ejecuta la consulta en el servidor
    MiSQL = "EXEC Proced '" & Forms!T_COMPRAS!CdAnio & "'"
    Set qdfTemp = conODBC.CreateQueryDef("")
    With qdfTemp
        .Prepare = dbQUnPrepare
        .SQL = MiSQL
        .ODBCTimeout = 240
        .Execute
    End With
 
    Set qdfTemp = conODBC.CreateQueryDef("")
    MiSQL = "if exists (select * from sysobjects where id = object_id('Proced') and sysstat & 0xf = 4)" & _
      " drop procedure Proced"
    With qdfTemp
        .Prepare = dbQUnprepare
        .SQL = MiSQL
        .ODBCTimeout = 120
        .Execute
    End With
                   
    Forms!T_COMPRAS!Lit_Estado.Caption = "Creando Tabla "
    DoEvents
    
    Set bd = CurrentDb()
    bd.TableDefs.Refresh
    
' Elimina la tabla auxiliar si existe en ACCESS
    For i = (bd.TableDefs.Count) - 1 To 0 Step -1
        If bd.TableDefs(i).Name = "T_COMPRAS" Then
            bd.TableDefs.Delete "T_COMPRAS"
        End If
    Next i
    
	' Traspasa la tabla de SQL Server a la base de datos local en ACCESS 97
    DoCmd.TransferDatabase acTable, "Bases de datos ODBC", _
"ODBC;DATABASE=<nombre de base de datos>;UID=<nombre de usuario>;PWD=<password>;DSN=<Creado en ODBC32>", _
          acTable, "Tmp_Dist", "T_COMPRAS"  
    bd.TableDefs.Refresh
    
' Borra la tabla auxiliar del servidor
    Set qdfTemp = conODBC.CreateQueryDef("")
    MiSQL = "if exists (select * from sysobjects where id = object_id('Tmp_ Dist') and sysstat & 0xf = 3)" & _
     " drop table Tmp_ Dist"
    With qdfTemp
        .Prepare = dbQUnprepare
        .SQL = MiSQL
        .ODBCTimeout = 120
        .Execute
    End With

    'Cierre de conexiones ODBC
    conODBC.Close : Set conODBC = nothing
    wsODBC.Close : Set wsODBC = nothing
    Set bd = Nothing
    Forms!T_COMPRAS!Lit_Estado.Caption = "Proceso finalizado"
    DoEvents
    DoCmd.SetWarnings True
    DoCmd.Hourglass False
    Forms!T_COMPRAS!Salir.SetFocus
End Sub