Option Compare Database Option Explicit



Descargar 67.76 Kb.
Fecha de conversión29.01.2017
Tamaño67.76 Kb.
Option Compare Database

Option Explicit


' ESTE PROCEDIMIENTO CONECTA CON LA BASE DE DATOS REMOTA Y ACTUALIZA

' LOS DATOS DE LA CLASIFICACIÓN IDENTIFICADA POR EL CÓDIGO DE LA JORNADA


Public Sub Exporta_Web_Maximos_Goleadores(comp_cod As Long)
Dim oDB_CON As ADODB.Connection ' Object

Dim sConStr As String

Dim sSQL As String, ocripto As Object

Dim db As Database, rst As Recordset

Dim sJugNombre As String, sJugEquipo As String, lNumGoles As Long

Set ocripto = CreateObject("Cripto.clsCripto")

sConStr = "DSN=webdbdepwin;UID=depwin;PWD=depwebwin"

Set ocripto = Nothing

DoCmd.OpenForm "Dialogo_Exportando_Web"

DoEvents


Application.Forms("Dialogo_Exportando_Web").Controls("status").Caption = "Exportando Máximos Goleadores ..."

DoEvents


Set oDB_CON = CreateObject("ADODB.Connection")

oDB_CON.Open sConStr

sSQL = "DELETE FROM DEPWIN_MGO WHERE com_cod = " & comp_cod

oDB_CON.Execute sSQL

' Envía datos de la competición

sSQL = "SELECT * FROM Maximos_Goleadores_3puntos WHERE com_cod = " & comp_cod

Set db = CurrentDb()

Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

While Not rst.EOF

sJugNombre = rst("Nombre") & " " & rst("Apellidos")

sJugEquipo = rst("Equipo")

lNumGoles = rst("Goles")

On Error Resume Next

sSQL = "INSERT INTO DEPWIN_MGO(com_cod,jug_nombre,jug_equipo,jug_num_goles) VALUES(" _

& comp_cod & ",'" & sJugNombre & "','" & sJugEquipo & "'," & lNumGoles & ")"

Err.Clear

oDB_CON.Execute sSQL

rst.MoveNext

Wend

rst.Close



oDB_CON.Close

Set oDB_CON = Nothing

Application.Forms("Dialogo_Exportando_Web").Visible = False

DoEvents


End Sub

Public Sub Exporta_Web_Jornada(jor_cod As Long)


Dim oDB_CON As ADODB.Connection ' Object

Dim sConStr As String

Dim sSQL As String, ocripto As Object

Dim db As Database, rst As Recordset

Dim com_cod, com_desc, com_dep, com_pista, com_cat, jor_num, jor_fecha, jor_vuelta

Dim enc_cod, enc_eq1, enc_eq2, enc_res_eq1, enc_res_eq2

Dim enc_fecha_partido, enc_hora_partido, enc_pista, enc_notas_aplazado

Dim enc_tantos_eq1, enc_tantos_eq2

Dim cla_posic, cla_equipo, cla_pga, cla_ppe, cla_pju, cla_pem, cla_afa, cla_enc

Dim cla_taf, cla_ten, cla_pto, cla_inc, cla_dpo, jor_dictamen

' Envía datos de la competición

sSQL = "SELECT com_cod, com_desc, dep_desc, pis_desc, cat_desc, jor_num, jor_fecha, jor_vuelta, jor_dictamen FROM " _

& "Competiciones, Deportes, Pistas, Categorias, Jornadas WHERE " _

& "com_dep=dep_cod AND com_pista=pis_cod AND com_cat=cat_cod AND jor_competicion=com_cod AND " _

& "jor_cod=" & jor_cod

Set db = CurrentDb()

Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

If Not rst.EOF Then

DoCmd.OpenForm "Dialogo_Exportando_Web"

DoEvents


Application.Forms("Dialogo_Exportando_Web").Controls("status").Caption = "Exportando Datos de Competición ..."

DoEvents


com_cod = rst("com_cod")

com_desc = rst("com_desc")

com_dep = rst("dep_desc")

com_pista = rst("pis_desc")

com_cat = rst("cat_desc")

jor_num = rst("jor_num")

jor_fecha = rst("jor_fecha")

jor_vuelta = rst("jor_vuelta")

jor_dictamen = rst("jor_dictamen")

jor_dictamen = ReplaceString(NoNulo(jor_dictamen), "'", "''")

rst.Close

Set ocripto = CreateObject("Cripto.clsCripto")


sConStr = "DSN=webdbdepwin;UID=depwin;PWD=depwebwin"

Set ocripto = Nothing

Set oDB_CON = CreateObject("ADODB.Connection")

oDB_CON.Open sConStr

oDB_CON.BeginTrans

sSQL = "DELETE FROM DEPWIN_ENC WHERE jor_cod=" & jor_cod

oDB_CON.Execute sSQL

sSQL = "DELETE FROM DEPWIN_CLA WHERE jor_cod=" & jor_cod

oDB_CON.Execute sSQL

sSQL = "DELETE FROM DEPWIN_JOR WHERE jor_cod=" & jor_cod

oDB_CON.Execute sSQL

sSQL = "DELETE FROM DEPWIN_COM WHERE com_cod=" & com_cod

oDB_CON.Execute sSQL

oDB_CON.CommitTrans

On Error Resume Next

sSQL = "INSERT INTO DEPWIN_COM(com_cod,com_desc,com_dep,com_pista,com_cat) VALUES(" _

& com_cod & ",'" & com_desc & "','" & com_dep & "','" & com_pista & "','" & com_cat & "')"

Err.Clear

oDB_CON.Execute sSQL

If Err <> 0 Then

sSQL = "UPDATE DEPWIN_COM SET com_desc='" & com_desc & "',com_dep='" & com_dep & "',com_pista='" & com_pista & "',com_cat='" & com_cat & "' WHERE com_cod=" & com_cod

oDB_CON.Execute sSQL

End If

sSQL = "INSERT INTO DEPWIN_JOR(jor_cod,jor_num,jor_fecha,jor_vuelta,jor_comp,jor_dictamen) VALUES(" _



& jor_cod & "," & jor_num & ",'" & jor_fecha & "'," & jor_vuelta & "," & com_cod & ",'" & jor_dictamen & "')"

Err.Clear

oDB_CON.Execute sSQL

If Err <> 0 Then

sSQL = "UPDATE DEPWIN_JOR SET jor_num=" & jor_num & ",jor_fecha='" & jor_fecha & "',jor_vuelta=" & jor_vuelta & ",jor_comp=" & com_cod & ",jor_dictamen='" & jor_dictamen & "' WHERE jor_cod=" & jor_cod

oDB_CON.Execute sSQL

End If

sSQL = "SELECT enc_cod, eq1.equ_desc, eq2.equ_desc, enc_resultado_eq1, enc_resultado_eq2, enc_fecha_partido, enc_hora_partido, pis_desc, enc_notas_aplazado FROM " _



& "((Pistas RIGHT JOIN Encuentros ON Pistas.pis_cod = Encuentros.enc_pista) INNER JOIN Equipos AS EQ1 ON Encuentros.enc_eq1 = EQ1.equ_cod) INNER JOIN Equipos AS EQ2 ON Encuentros.enc_eq2 = EQ2.equ_cod " _

& "WHERE enc_jornada = " & jor_cod

Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

Application.Forms("Dialogo_Exportando_Web").Controls("status").Caption = "Exportando Datos de Encuentros ..."

DoEvents

While Not rst.EOF

enc_cod = rst("enc_cod")

enc_eq1 = rst("eq1.equ_desc")

enc_eq2 = rst("eq2.equ_desc")

enc_res_eq1 = NoNulo(rst("enc_resultado_eq1"))

enc_res_eq2 = NoNulo(rst("enc_resultado_eq2"))

enc_fecha_partido = NoNulo(rst("enc_fecha_partido"))

enc_hora_partido = NoNulo(rst("enc_hora_partido"))

enc_pista = NoNulo(rst("pis_desc"))

enc_notas_aplazado = NoNulo(rst("enc_notas_aplazado"))

enc_tantos_eq1 = NoNulo(rst("enc_tantos_eq1"))

enc_tantos_eq2 = NoNulo(rst("enc_tantos_eq2"))

sSQL = "INSERT INTO DEPWIN_ENC(jor_cod,enc_cod,enc_eq1,enc_eq2,enc_res_eq1,enc_res_eq2,enc_fecha_partido,enc_hora_partido,enc_pista,enc_notas_aplazado,enc_tantos_eq1,enc_tantos_eq2) VALUES(" _

& jor_cod & "," & enc_cod & ",'" & enc_eq1 & "','" & enc_eq2 & "','" & enc_res_eq1 & "','" & enc_res_eq2 & "','" & enc_fecha_partido & "','" & enc_hora_partido & "','" & enc_pista & "', '" & enc_notas_aplazado & "','" & enc_tantos_eq1 & "','" & enc_tantos_eq2 & "')"

Err.Clear

oDB_CON.Execute sSQL

If Err <> 0 Then

sSQL = "UPDATE DEPWIN_ENC SET enc_eq1='" & enc_eq1 & "',enc_eq2='" & enc_eq2 & "',enc_res_eq1='" & enc_res_eq1 & "',enc_res_eq2='" & enc_res_eq2 & "',enc_fecha_partido='" & enc_fecha_partido & "',enc_hora_partido='" & enc_hora_partido & "', enc_pista='" & enc_pista & "', enc_notas_aplazado='" & enc_notas_aplazado & "',enc_tantos_eq1='" & enc_tantos_eq1 & "',enc_tantos_eq2='" & enc_tantos_eq2 & "' WHERE jor_cod=" & jor_cod & " AND enc_cod=" & enc_cod

oDB_CON.Execute sSQL

End If

rst.MoveNext



DoEvents

Wend


rst.Close

sSQL = "SELECT cla_cod,cla_posic,equ_desc,cla_partidos_jugados,cla_partidos_ganados,cla_partidos_perdidos," _

& "cla_partidos_empatados,cla_afavor,cla_encontra,cla_tantosfavor,cla_tantoscontra,cla_puntos_acum,cla_dpor,cla_ob FROM " _

& "Clasificaciones, Equipos WHERE cla_equipo=equ_cod AND cla_jornada=" & jor_cod

Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

Application.Forms("Dialogo_Exportando_Web").Controls("status").Caption = "Exportando Clasificación ..."

DoEvents

While Not rst.EOF

cla_posic = rst("cla_posic")

cla_equipo = rst("equ_desc")

cla_pga = NoNulo(rst("cla_partidos_ganados"))

cla_ppe = NoNulo(rst("cla_partidos_perdidos"))

cla_pju = NoNulo(rst("cla_partidos_jugados"))

cla_pem = NoNulo(rst("cla_partidos_empatados"))

cla_afa = NoNulo(rst("cla_afavor"))

cla_enc = NoNulo(rst("cla_encontra"))

cla_taf = NoNulo(rst("cla_tantosfavor"))

cla_ten = NoNulo(rst("cla_tantoscontra"))

cla_pto = NoNulo(rst("cla_puntos_acum"))

cla_inc = NoNulo(rst("cla_ob"))

cla_dpo = NoNulo(rst("cla_dpor"))

sSQL = "INSERT INTO DEPWIN_CLA(jor_cod,cla_posic,cla_equipo,cla_pga,cla_ppe,cla_pju,cla_pem,cla_afa,cla_enc,cla_taf,cla_ten,cla_pto,cla_inc,cla_dpo) VALUES(" _

& jor_cod & "," & cla_posic & ",'" & cla_equipo & "','" & cla_pga & "','" & cla_ppe & "','" & cla_pju & "','" & cla_pem & "','" & cla_afa & "','" & cla_enc & "','" & cla_taf & "','" & cla_ten _

& "','" & cla_pto & "','" & cla_inc & "','" & cla_dpo & "')"

Err.Clear

oDB_CON.Execute sSQL

If Err <> 0 Then

sSQL = "UPDATE DEPWIN_CLA SET cla_equipo='" & cla_equipo & "',cla_pga='" & cla_pga & "',cla_ppe='" & cla_ppe & "',cla_pju='" & cla_pju & "',cla_pem='" & cla_pem & "',cla_afa='" & cla_afa & "',cla_enc='" & cla_enc & "',cla_taf='" & cla_taf & "',cla_ten='" & cla_ten & "',cla_pto='" & cla_pto & "',cla_inc='" & cla_inc & "',cla_dpo='" & cla_dpo & "' WHERE jor_cod=" & jor_cod & " AND cla_posic=" & cla_posic

oDB_CON.Execute sSQL

End If


rst.MoveNext

DoEvents


Wend

oDB_CON.Close

Set oDB_CON = Nothing

Application.Forms("Dialogo_Exportando_Web").Visible = False

DoEvents

End If


rst.Close

End Sub


Public Sub EliminaCompDeWeb(com_cod As Long)

Dim db As Database, oRST As Recordset, sSQL As String, jor_cod As Long

Dim oDB_CON As ADODB.Connection ' Object

Dim sConStr As String, ocripto As Object

Set ocripto = CreateObject("Cripto.clsCripto")

sConStr = "DSN=webdbdepwin;UID=depwin;PWD=depwebwin"

Set ocripto = Nothing

Set oDB_CON = CreateObject("ADODB.Connection")

oDB_CON.Open sConStr

sSQL = "SELECT jor_cod FROM Jornadas WHERE jor_competicion = " & com_cod

Set db = CurrentDb()

Set oRST = db.OpenRecordset(sSQL)

While Not oRST.EOF

jor_cod = oRST(0)

sSQL = "DELETE DEPWIN_ENC WHERE jor_cod=" & jor_cod

oDB_CON.Execute sSQL

sSQL = "DELETE DEPWIN_CLA WHERE jor_cod=" & jor_cod

oDB_CON.Execute sSQL

sSQL = "DELETE DEPWIN_JOR WHERE jor_cod=" & jor_cod

oDB_CON.Execute sSQL

oRST.MoveNext

Wend


sSQL = "DELETE DEPWIN_COM WHERE com_cod=" & com_cod

oDB_CON.Execute sSQL


oDB_CON.Close

Set oDB_CON = Nothing
End Sub

'Public Sub EliminaOlimpiadaDeWeb(com_cod As Long)

'Dim db As Database, oRST As Recordset, sSQL As String, jor_cod As Long

'

'sSQL = "SELECT jor_cod FROM Jornadas WHERE jor_competicion = " & com_cod



'Set db = CurrentDb()

'Set oRST = db.Execute(sSQL)

'While Not oRST.EOF

' jor_cod = oRST(0)

'' sSQL = "DELETE DEPWIN_ENC WHERE jor_cod=" & jor_cod

'oDB_CON.Execute sSQL

'sSQL = "DELETE DEPWIN_CLA WHERE jor_cod=" & jor_cod

'oDB_CON.Execute sSQL

's 'SQL = "DELETE DEPWIN_JOR WHERE jor_cod=" & jor_cod

'oDB_CON.Execute sSQL

''oRST.MoveNext

'Wend


'sSQL = "DELETE DEPWIN_OCO WHERE OCO_OLI=" & lOli

'oDB_CON.Execute sSQL

'sSQL = "SELECT * FROM Olimpiadas_Competiciones WHERE oli_cod=" & lOli
'

'End Sub
Public Sub Exporta_Web_Competicion(com_cod As Long)


Dim db As Database, rst As Recordset, sSQL As String

' Envía datos de la competición

sSQL = "SELECT com_cod, com_desc, dep_desc, pis_desc, cat_desc, jor_cod, jor_num, jor_fecha, jor_vuelta, jor_dictamen FROM " _

& "Competiciones, Deportes, Pistas, Categorias, Jornadas WHERE " _

& "com_dep=dep_cod AND com_pista=pis_cod AND com_cat=cat_cod AND jor_competicion=com_cod AND " _

& "com_cod=" & com_cod

Set db = CurrentDb()

Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

While Not rst.EOF

Exporta_Web_Jornada rst("jor_cod")

rst.MoveNext

Wend


rst.Close

Exporta_Web_Maximos_Goleadores com_cod

End Sub

Public Sub Exporta_Web_Olimpiada(lOli As Long)


Dim oDB_CON As ADODB.Connection ' Object

Dim sConStr As String

Dim sSQL As String, ocripto As Object

Dim db As Database, rst As Recordset

Dim sOli As String, sFechIni As String, sFechFin As String

Dim lCom As Long

' Envía datos de la olimpiada

sSQL = "SELECT * FROM Olimpiadas WHERE oli_cod = " & lOli

Set db = CurrentDb()

Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

If Not rst.EOF Then

DoCmd.OpenForm "Dialogo_Exportando_Web"

DoEvents

Application.Forms("Dialogo_Exportando_Web").Controls("status").Caption = "Exportando Datos de JJ. DD. ..."

DoEvents

sOli = rst("oli_nombre")

sFechIni = rst("oli_fecha_inicio")

sFechFin = rst("oli_fecha_fin")

rst.Close

Set ocripto = CreateObject("Cripto.clsCripto")

' sConStr = "DSN=webdb;UID=qr501;PWD=" & ocripto.CRIPTO_traduce("7VG$'TT4", ocripto.GLNG_DECODIFICAR)

sConStr = "DSN=webdbdepwin;UID=depwin;PWD=depwebwin"

Set ocripto = Nothing

Set oDB_CON = CreateObject("ADODB.Connection")

oDB_CON.Open sConStr

On Error Resume Next

sSQL = "DELETE FROM DEPWIN_OLI WHERE oli_cod=" & lOli

Err.Clear

oDB_CON.Execute sSQL

sSQL = "INSERT INTO DEPWIN_OLI(oli_cod, oli_nom, oli_fco, oli_ffi) VALUES(" _

& lOli & ",'" & sOli & "','" & voltea_fecha(sFechIni) & "','" & voltea_fecha(sFechFin) & "')"

Err.Clear

oDB_CON.Execute sSQL

If Err <> 0 Then

sSQL = "UPDATE DEPWIN_COM SET oli_nom='" & sOli & "', oli_fco='" & sFechIni & "', oli_ffi='" & sFechFin & "' WHERE oli_cod = " & lOli

oDB_CON.Execute sSQL

End If

'sSQL = "DELETE DEPWIN_OCO WHERE OCO_OLI=" & lOli



'oDB_CON.Execute sSQL

sSQL = "SELECT * FROM Olimpiadas_Competiciones WHERE oli_cod=" & lOli

Set rst = db.OpenRecordset(sSQL, dbOpenDynaset)

Application.Forms("Dialogo_Exportando_Web").Controls("status").Caption = "Exportando Nombres de Competiciones ..."

DoEvents

While Not rst.EOF

lCom = rst("oli_comp")

sSQL = "INSERT INTO DEPWIN_OCO(OCO_OLI, OCO_COM) VALUES(" & lOli & ", " & lCom & ")"

oDB_CON.Execute sSQL

Exporta_Web_Competicion lCom

rst.MoveNext

Wend


oDB_CON.Close

Set oDB_CON = Nothing

Application.Forms("Dialogo_Exportando_Web").Visible = False

DoEvents


End If

rst.Close


End Sub


La base de datos está protegida por derechos de autor ©bazica.org 2016
enviar mensaje

    Página principal