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