Public SIP As ADODB.Connection

Public xdb As Database

Public xra As ADODB.Recordset

Public xrb As ADODB.Recordset

Public xrc As ADODB.Recordset

Public ra As DAO.Recordset

Public xOperario As Variant

Public TodoUso As Variant

Public TodoUso1 As Variant

Public TodoUso2 As Variant

Public Function Iniciar()

Dim noOK As Boolean: noOK = True

Dim ParaEval As String

On Error Resume Next

'DoCmd.ShowToolbar "Menu bar", acToolbarNo

'DoCmd.ShowToolbar "Ribbon", acToolbarYes

On Error GoTo 0

Set xdb = CurrentDb

Set ra = xdb.OpenRecordset("Local conexion SQL", dbOpenSnapshot)

Set SIP = New ADODB.Connection

ra.MoveFirst

ParaEval = 0

Do While Not ra.EOF

    If ra![Activa] = "Verdadero" Then

        ParaEval = 1

        If IsNull(ra!User) Then

            If CrearConexion(ra!ipServer, ra!Catalogo, "") Then

                SIP.Open "Provider=sqloledb;Data Source=" & ra!ipServer & ";Initial Catalog=" & ra!Catalogo & ";Integrated Security=SSPI"

                noOK = False

            End If

        Else

            If CrearConexion(ra!ipServer, ra!Catalogo, ra!User) Then

                SIP.Open "Provider=sqloledb;Data Source=" & ra!ipServer & ";Initial Catalog=" & ra!Catalogo, ra!User, ra!pwd

                noOK = False

            End If

        End If

        

        If noOK Then

            ra.Close

        '    DoCmd.ShowToolbar "Menu bar", acToolbarYes

            MsgBox "Error al conectar al servidor de base de datos", vbCritical, "Iniciar PRINTUX"

            Application.Quit acQuitSaveNone

            Exit Function

        Else

            Dim tdf As TableDef

            For Each tdf In CurrentDb.TableDefs

                If tdf.Connect <> vbNullString Then

                    If InStr(1, tdf.Connect, "DSN=", 1) > 0 Then

                        If IsNull(ra!User) Then

                            tdf.Connect = "ODBC;DSN=" & ra!NomODBC & ";APP=Microsoft Office;DATABASE=" & ra!Catalogo & ";TABLE=" & tdf.Name

                        Else

                            tdf.Connect = "ODBC;DSN=" & ra!NomODBC & ";UID=" & ra!User & ";PWD=" & ra!pwd & ";APP=Microsoft Office;DATABASE=" & ra!Catalogo & ";TABLE=" & tdf.Name

                        End If

                        tdf.RefreshLink

                    End If

                End If

            Next

        End If

    End If

ra.MoveNext

Loop

Titulo01 = "Control de conexión SQL"

If ParaEval = "0" Then

    Informa = "Lo siento pero no se puede abrir el Software" & Chr(13) & Chr(10)

    Informa = Informa & "por que no tiene ninguna conexión SQL activa." & Chr(13) & Chr(10)

    MsgBox Informa, vbExclamation, Titulo01

    DoCmd.Quit

End If

ra.Close

SIP.CommandTimeout = 0

End Function

Public Function CrearConexion(stServer As String, stDatabase As String, Optional stUser As String) As Boolean

On Error GoTo CrearConexion_Err

Dim stConnect As String

If Len(stUser) = 0 Then

    stConnect = "Description=Conexión Mundo Virtual PC" & vbCr & "SERVER=" & stServer & vbCr & "DATABASE=" & stDatabase & vbCr & "Trusted_Connection=Yes"

Else

    stConnect = "Description=Conexión Mundo Virtual PC" & vbCr & "SERVER=" & stServer & vbCr & "DATABASE=" & stDatabase & vbCr

End If

DBEngine.RegisterDatabase ra!NomODBC, "SQL Server", True, stConnect

CrearConexion = True

    Exit Function

CrearConexion_Err:

    CrearConexion = False

    MsgBox "La Conexión a la DataBase encontró un error inesperado: " & Err.Description

End Function