Publicado: 29/01/2008 10:32:32 amAsunto: Error 3705 en tiempo de ejecucion la operacion no esta permi
tengo el siguiente problema Error 3705 en tiempo de ejecucion la operacion no esta permitida si el objeto esta abierto este el el codigo
cuando cambio del formulari agregar a buscar o viseversa me aparece el mensaje 3705, espero puedan ayudarme, saludos
formulario agregar
Dim Op As Byte
Private Sub CmdAgregar_Click()
Op = 1
Call Limpiar
If MsgBox("Seguro de agregar registro", 36, "Confirmacion") = 6 Then
RsExpedientes.AddNew
Frame1.Enabled = True
Frame2(1).Enabled = False
CmdAgregar.Enabled = False
CmdSalir.Enabled = True
CmdCancelar.Enabled = True
CmdGuardar.Enabled = True
TxtTit.SetFocus
End If
End Sub
Private Sub CmdCancelar_Click()
Frame1.Enabled = False
Frame2(1).Enabled = True
CmdAgregar.Enabled = True
CmdSalir.Enabled = True
CmdCancelar.Enabled = False
CmdGuardar.Enabled = False
If Op = 1 Then
RsExpedientes.CancelUpdate
'RsExpedientes.MoveLast
'Call LlenarDatos
End If
CmdAgregar.SetFocus
End Sub
Private Sub CmdDesplaza_Click(Index As Integer)
Select Case Index
Case 0
RsExpedientes.MoveFirst
Case 1
RsExpedientes.MovePrevious
If RsExpedientes.BOF Then RsExpedientes.MoveFirst
Case 2
RsExpedientes.MoveNext
If RsExpedientes.EOF Then RsExpedientes.MoveLast
Case 3
RsExpedientes.MoveLast
End Select
RsExpedientes.Update
Call LlenarDatos
End Sub
Private Sub CmdCont_Click()
Picture2.Visible = False
TxtDesc.SetFocus
End Sub
Private Sub CmdContinuar_Click()
Picture1.Visible = False
Txtinsig.SetFocus
End Sub
Private Sub CmdDeta_Click()
Picture2.Visible = True
Txtu.SetFocus
End Sub
Private Sub CmdFolios_Click()
Picture1.Visible = True
Txtfu.SetFocus
End Sub
Private Sub CmdGuardar_Click()
Dim Fecha$
'Fecha = TxtFuc1 + "/" + TxtFuc2 + "/" + TxtFuc3
'If TxtNum_hc <> "" And Fecha <> "" And IsDate(Fecha) Then
RsExpedientes.Fields("Titulo") = TxtTit
RsExpedientes.Fields("Asunto") = TxtAsun
'RsExpedientes.Fields("FechaUltmConsulta") = CDate(Fecha)
If TxtFi1 <> "" And TxtFi2 <> "" And TxtFi3 <> "" Then RsExpedientes.Fields("Fecini") = CDate(TxtFi1 + "/" + TxtFi2 + "/" + TxtFi3)
If TxtFf1 <> "" And TxtFf2 <> "" And TxtFf3 <> "" Then RsExpedientes.Fields("Fecfin") = CDate(TxtFf1 + "/" + TxtFf2 + "/" + TxtFf3)
RsExpedientes.Fields("Data_topica") = CboDataHis.Text
RsExpedientes.Fields("Fondo") = TxtFond
RsExpedientes.Fields("Secc") = TxtSec
RsExpedientes.Fields("Serie") = TxtSerie
RsExpedientes.Fields("Signatura") = TxtSig
RsExpedientes.Fields("Leg_caja") = TxtLegC
RsExpedientes.Fields("Expediente_cua") = TxtExpCua
RsExpedientes.Fields("Estanteria") = TxtEst
RsExpedientes.Fields("N_folios") = Txtnfol
RsExpedientes.Fields("Folios_utiles") = Txtfu
RsExpedientes.Fields("Folios_insertos") = Txtfi
RsExpedientes.Fields("Folios_repetidos") = Txtfr
RsExpedientes.Fields("Folios_faltantes") = Txtfq
RsExpedientes.Fields("Folios_folia") = Txtffo
RsExpedientes.Fields("Folios_blanco") = Txtfb
RsExpedientes.Fields("observaciones") = Txtfobs
RsExpedientes.Fields("Incluido_signatura") = Txtinsig
RsExpedientes.Fields("Leg_caja_incsig") = TxtisigLC
RsExpedientes.Fields("Expediente_cua_incsig") = Txtisigec
RsExpedientes.Fields("Estado_conservacion") = CboEstCons.Text
RsExpedientes.Fields("Folios_Nutiles") = Txtu
RsExpedientes.Fields("Folios_Ninsertos") = Txtb
RsExpedientes.Fields("Folios_Nblanco") = Txtr
RsExpedientes.Fields("Folios_Npi") = Txtpi
RsExpedientes.Fields("Folios_Nen") = Txtin
RsExpedientes.Fields("Folios_Nrepetidos") = Txti
RsExpedientes.Fields("Folios_Nquemados") = Txtq
RsExpedientes.Fields("Folios_Nper") = Txtz
RsExpedientes.Fields("Folios_Nsuel") = Txtfs
RsExpedientes.Fields("Folios_Nrot") = Txtro
RsExpedientes.Fields("Observacionesn") = Txtob
RsExpedientes.Fields("Descripcion") = TxtDesc
RsExpedientes.Fields("Responsable_desc") = TxtResp
RsExpedientes.Fields("Fecha_desc") = DTPicker3
'RsExpedientes.Fields("Fecha_desc") = Date
RsExpedientes.Fields("Nombre") = Usuario
RsExpedientes.Update
'RsconteoH.AddNew
'RsconteoH.Fields("Fechabusq") = Date
'RsconteoH.Fields("Nombre") = Usuario
'RsconteoH.Update
Frame1.Enabled = False
Frame2(1).Enabled = True
CmdAgregar.Enabled = True
CmdSalir.Enabled = True
CmdCancelar.Enabled = False
CmdGuardar.Enabled = False
If Op = 1 Then
RsExpedientes.MoveLast
Call LlenarDatos
End If
CmdAgregar.SetFocus
'Else
' If TxtNum_hc = "" Then
' MsgBox "Sin historia clinica", vbInformation, "Mensaje"
' TxtNum_hc.SetFocus
' Else
' MsgBox "sin fecha de ultima consulta o fecha incorrecta", vbInformation, "Mensaje"
' TxtFuc1.SetFocus
'End If
'End If
End Sub
Private Sub CmdSalir_Click()
Me.Hide
End Sub
Sub Limpiar()
TxtTit.Text = Empty
TxtAsun.Text = Empty
TxtFi1.Text = Empty
TxtFi2.Text = Empty
TxtFi3.Text = Empty
TxtFf1.Text = Empty
TxtFf2.Text = Empty
TxtFf3.Text = Empty
CboDataHis.Text = Empty
TxtFond.Text = Empty
TxtSec.Text = Empty
TxtSerie.Text = Empty
TxtSig.Text = Empty
TxtLegC.Text = Empty
TxtExpCua.Text = Empty
TxtEst.Text = Empty
Txtnfol.Text = Empty
Txtfu.Text = Empty
Txtfi.Text = Empty
Txtfr.Text = Empty
Txtfq.Text = Empty
Txtffo.Text = Empty
Txtfb.Text = Empty
Txtfobs.Text = Empty
Txtinsig.Text = Empty
TxtisigLC.Text = Empty
Txtisigec.Text = Empty
CboEstCons.Text = Empty
Txtu.Text = Empty
Txtb.Text = Empty
Txtr.Text = Empty
Txtpi.Text = Empty
Txtin.Text = Empty
Txti.Text = Empty
Txtq.Text = Empty
Txtz.Text = Empty
Txtfs.Text = Empty
Txtro.Text = Empty
Txtob.Text = Empty
TxtDesc = Empty
TxtResp.Text = Empty
Picture1.Visible = False
Picture2.Visible = False
'DTPicker3.Text = Empty
End Sub
Sub LlenarDatos()
If Not IsNull(RsExpedientes.Fields(0)) Then
TxtTit.Text = RsExpedientes.Fields(0)
Else
TxtTit.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(1)) Then
TxtAsun.Text = RsExpedientes.Fields(1)
Else
TxtAsun.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(2)) Then
TxtFi1.Text = Left(RsExpedientes.Fields(2), 2)
Else
TxtFi1.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(2)) Then
TxtFi2.Text = Mid(RsExpedientes.Fields(2), 4, 2)
Else
TxtFi2.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(2)) Then
TxtFi3.Text = Right(RsExpedientes.Fields(2), 4)
Else
TxtFi3.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(3)) Then
TxtFf1.Text = Left(RsExpedientes.Fields(3), 2)
Else
TxtFf1.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(3)) Then
TxtFf2.Text = Mid(RsExpedientes.Fields(3), 4, 2)
Else
TxtFf2.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(3)) Then
TxtFf3.Text = Right(RsExpedientes.Fields(3), 4)
Else
TxtFf3.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(5)) Then
TxtFond.Text = RsExpedientes.Fields(5)
Else
TxtFond.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(6)) Then
TxtSec.Text = RsExpedientes.Fields(6)
Else
TxtSec.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(7)) Then
TxtSerie.Text = RsExpedientes.Fields(7)
Else
TxtSerie.Text = ""
End If
If Not IsNull(RsExpedientes.Fields() Then
TxtSig.Text = RsExpedientes.Fields(
Else
TxtSig.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(9)) Then
TxtLegC.Text = RsExpedientes.Fields(9)
Else
TxtLegC.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(10)) Then
TxtExpCua.Text = RsExpedientes.Fields(10)
Else
TxtExpCua.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(11)) Then
TxtEst.Text = RsExpedientes.Fields(11)
Else
TxtEst.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(12)) Then
Txtnfol.Text = RsExpedientes.Fields(13)
Else
Txtnfol.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(13)) Then
Txtfu.Text = RsExpedientes.Fields(13)
Else
Txtfu.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(14)) Then
Txtfi.Text = RsExpedientes.Fields(14)
Else
Txtfi.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(15)) Then
Txtfr.Text = RsExpedientes.Fields(15)
Else
Txtfr.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(16)) Then
Txtfq.Text = RsExpedientes.Fields(16)
Else
Txtfq.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(17)) Then
Txtffo.Text = RsExpedientes.Fields(17)
Else
Txtffo.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(1) Then
Txtfb.Text = RsExpedientes.Fields(1
Else
Txtfb.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(19)) Then
Txtfobs.Text = RsExpedientes.Fields(19)
Else
Txtfobs.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(20)) Then
Txtinsig.Text = RsExpedientes.Fields(20)
Else
Txtinsig.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(21)) Then
TxtisigLC.Text = RsExpedientes.Fields(21)
Else
TxtisigLC.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(22)) Then
Txtisigec.Text = RsExpedientes.Fields(22)
Else
Txtisigec.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(24)) Then
Txtu.Text = RsExpedientes.Fields(24)
Else
Txtu.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(25)) Then
Txtb.Text = RsExpedientes.Fields(25)
Else
Txtb.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(26)) Then
Txtr.Text = RsExpedientes.Fields(26)
Else
Txtr.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(27)) Then
Txtpi.Text = RsExpedientes.Fields(27)
Else
Txtpi.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(2) Then
Txtin.Text = RsExpedientes.Fields(2
Else
Txtin.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(29)) Then
Txti.Text = RsExpedientes.Fields(29)
Else
Txti.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(30)) Then
Txtq.Text = RsExpedientes.Fields(30)
Else
Txtq.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(31)) Then
Txtz.Text = RsExpedientes.Fields(31)
Else
Txtz.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(32)) Then
Txtfs.Text = RsExpedientes.Fields(32)
Else
Txtfs.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(33)) Then
Txtro.Text = RsExpedientes.Fields(33)
Else
Txtro.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(34)) Then
Txtob.Text = RsExpedientes.Fields(34)
Else
Txtob.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(35)) Then
TxtDesc.Text = RsExpedientes.Fields(35)
Else
TxtDesc.Text = ""
End If
If Not IsNull(RsExpedientes.Fields(36)) Then
TxtResp.Text = RsExpedientes.Fields(36)
Else
TxtResp.Text = ""
End If
RsExpedientes.Update
End Sub
Private Sub Form_Load()
RsExpedientes.Open "TBEXPEDIENTES", Conex, adOpenDynamic, adLockOptimistic
If Not RsExpedientes.EOF Then Call LlenarDatos
Call Limpiar
'RsExpedientes.Close
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub Txtisigec_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtisigLC.SetFocus
End Sub
Private Sub TxtTit_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtAsun.SetFocus
End Sub
Private Sub TxtAsun_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtFi1.SetFocus
End Sub
Private Sub TxtFi1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtFi2.SetFocus
Call Numero(KeyAscii)
End Sub
Private Sub TxtFi2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtFi3.SetFocus
Call Numero(KeyAscii)
End Sub
Private Sub TxtFi3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtFf1.SetFocus
Call Numero(KeyAscii)
End Sub
Private Sub TxtFf1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtFf2.SetFocus
Call Numero(KeyAscii)
End Sub
Private Sub TxtFf2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtFf3.SetFocus
Call Numero(KeyAscii)
End Sub
Private Sub TxtFf3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then CboDataHis.SetFocus
Call Numero(KeyAscii)
End Sub
Private Sub CboDataHis_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtFond.SetFocus
End Sub
Private Sub TxtFond_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtSec.SetFocus
End Sub
Private Sub TxtSec_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtSerie.SetFocus
End Sub
Private Sub TxtSerie_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtSig.SetFocus
End Sub
Private Sub TxtSig_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtLegC.SetFocus
End Sub
Private Sub TxtLegC_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtExpCua.SetFocus
End Sub
Private Sub TxtExpCua_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtEst.SetFocus
End Sub
Private Sub TxtEst_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtnfol.SetFocus
End Sub
Private Sub Txtnfol_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then CmdFolios.SetFocus
End Sub
Private Sub Txtfu_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtfi.SetFocus
End Sub
Private Sub Txtfi_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtfr.SetFocus
End Sub
Private Sub Txtfr_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtfq.SetFocus
End Sub
Private Sub Txtfq_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtffo.SetFocus
End Sub
Private Sub Txtffo_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtfb.SetFocus
End Sub
Private Sub Txtfb_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtfobs.SetFocus
End Sub
Private Sub Txtfobs_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then CmdContinuar.SetFocus
End Sub
Private Sub Txtinsig_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtisigec.SetFocus
End Sub
Private Sub TxtisigLC_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then CboEstCons.SetFocus
End Sub
Private Sub CboEstCons_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then CmdDeta.SetFocus
End Sub
Private Sub Txtu_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtb.SetFocus
End Sub
Private Sub Txtb_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtr.SetFocus
End Sub
Private Sub Txtr_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtpi.SetFocus
End Sub
Private Sub Txtpi_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtin.SetFocus
End Sub
Private Sub Txtin_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txti.SetFocus
End Sub
Private Sub Txti_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtq.SetFocus
End Sub
Private Sub Txtq_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtz.SetFocus
End Sub
Private Sub Txtz_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtfs.SetFocus
End Sub
Private Sub Txtfs_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtro.SetFocus
End Sub
Private Sub Txtro_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then Txtob.SetFocus
End Sub
Private Sub Txtob_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then CmdCont.SetFocus
End Sub
Private Sub TxtDesc_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then TxtResp.SetFocus
End Sub
Private Sub TxtResp_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then DTPicker3.SetFocus
End Sub
Private Sub DTPicker3_KeyPress(KeyAscii As Integer)
If KeyAscii = 39 Then KeyAscii = 0
If KeyAscii = 13 Then CmdGuardar.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
RsExpedientes.Close
End Sub
este el formulario de busqueda y modificacion
Private Sub CmdBuscarExpedientes_Click()
Dim Fec1$, Fec2$
Fec1 = TxtFi1 + "/" + TxtFi2 + "/" + TxtFi3
Fec2 = TxtFf1 + "/" + TxtFf2 + "/" + TxtFf3
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
MsgBox "Ingrese alguna condicion para la búsqueda", vbInformation, "Aviso"
Exit Sub
End If
Buscar
End Sub
Sub Buscar()
Dim K As String, Fec1$, Fec2$, Ent As Boolean
Ent = False
K = "Select * from TBEXPEDIENTES"
If Trim(TxtTit) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Titulo LIKE '" & Trim(TxtTit) & "%'"
End If
If TxtFi1 <> "" Then
Fec1 = TxtFi2 + "/" + TxtFi1 + "/" + TxtFi3
If Not IsDate(Fec1) Then
TxtFi1 = "": TxtFi2 = "": TxtFi3 = "": Exit Sub
Else
Fech = CDate(Fec1)
If Ent Then K = K & " And " Else Ent = True: K = K & " Where "
'k = k & " Where "
K = K & " FECINI = #" & Fec1 & "#"
End If
End If
If TxtFf1 <> "" Then
Fec2 = TxtFf2 + "/" + TxtFf1 + "/" + TxtFf3
If Not IsDate(Fec2) Then
TxtFf1 = "": TxtFf2 = "": TxtFf3 = "": Exit Sub
Else
Fech = CDate(Fec2)
If Ent Then K = K & " And " Else Ent = True: K = K & " Where "
'k = k & " Where "
K = K & " FECFIN = #" & Fec2 & "#"
End If
End If
If Trim(CboDataHis) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Data_Topica LIKE '" & Trim(CboDataHis) & "%'"
End If
If Trim(TxtFond) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Fondo LIKE '" & Trim(TxtFond) & "%'"
End If
If Trim(TxtSec) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Secc LIKE '" & Trim(TxtSec) & "%'"
End If
If Trim(TxtSerie) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Serie LIKE '" & Trim(TxtSerie) & "%'"
End If
If Trim(TxtLegC) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Leg_Caja LIKE '" & Trim(TxtLegC) & "%'"
End If
If Trim(TxtExpCua) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Expediente_cua LIKE '" & Trim(TxtExpCua) & "%'"
End If
If Trim(TxtEst) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Estanteria LIKE '" & Trim(TxtEst) & "%'"
End If
If Trim(TxtSig) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Signatura LIKE '" & Trim(TxtSig) & "%'"
End If
If Trim(Txtnfol) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " N_folios LIKE '" & Trim(Txtnfol) & "%'"
End If
If Trim(Txtinsig) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Incluido_Signatura LIKE '" & Trim(Txtinsig) & "%'"
End If
If Trim(CboEstCons) <> "" Then
If Ent Then K = K & " and " Else Ent = True: K = K & " Where "
K = K & " Estado_Conservacion LIKE '" & Trim(CboEstCons) & "%'"
End If
Set RsExpedientes = New ADODB.Recordset
RsExpedientes.CursorLocation = adUseClient
RsExpedientes.Open K, Conex.ConnectionString, adOpenDynamic, adLockOptimistic, adCmdText
Set DgExpedientes.DataSource = RsExpedientes
' MsgBox "No hay Registros con esa información", vbInformation , "Aviso"
End Sub
Private Sub CmdCancelar_Click()
TxtTit.Text = ""
TxtFi1 = "": TxtFi2 = "": TxtFi3 = ""
TxtFf1 = "": TxtFf2 = "": TxtFf3 = ""
TxtFond.Text = ""
TxtSec.Text = ""
TxtSerie.Text = ""
TxtLegC.Text = ""
TxtExpCua.Text = ""
TxtEst.Text = ""
TxtSig.Text = ""
Txtnfol.Text = ""
Txtinsig.Text = ""
TxtTit.SetFocus
CmdBuscarExpedientes_Click
End Sub
Private Sub CmdModificar_Click()
'Op = 2
'FrmModificarHistorias.Show
Op = 2
If DgExpedientes.ApproxCount > 0 Then
Modificar
FrmModificarExpedientes.Show vbModal
End If
End Sub
Private Sub CmdSalir_Click(Index As Integer)
RsExpedientes.Cancel
Me.Hide
End Sub
Sub Modificar()
'If RsHistoria.RecordCount > 0 Then
With FrmModificarExpedientes
.TxtTit = DgExpedientes.Columns(0)
.TxtAsun = DgExpedientes.Columns(1)
.TxtFi1 = Left(DgExpedientes.Columns(2), 2)
.TxtFi2 = Mid(DgExpedientes.Columns(2), 4, 2)
.TxtFi3 = Right(DgExpedientes.Columns(2), 4)
.TxtFf1 = Left(DgExpedientes.Columns(3), 2)
.TxtFf2 = Mid(DgExpedientes.Columns(3), 4, 2)
.TxtFf3 = Right(DgExpedientes.Columns(3), 4)
.CboDataHis = DgExpedientes.Columns(4)
.TxtFond = DgExpedientes.Columns(5)
.TxtSec = DgExpedientes.Columns(6)
.TxtSerie = DgExpedientes.Columns(7)
.TxtSig = DgExpedientes.Columns(
.TxtLegC = DgExpedientes.Columns(9)
.TxtExpCua = DgExpedientes.Columns(10)
.TxtEst = DgExpedientes.Columns(11)
.Txtnfol = DgExpedientes.Columns(12)
.Txtfu = DgExpedientes.Columns(13)
.Txtfi = DgExpedientes.Columns(14)
.Txtfr = DgExpedientes.Columns(15)
.Txtfq = DgExpedientes.Columns(16)
.Txtffo = DgExpedientes.Columns(17)
.Txtfb = DgExpedientes.Columns(1
.Txtfobs = DgExpedientes.Columns(19)
.Txtinsig = DgExpedientes.Columns(20)
.TxtisigLC = DgExpedientes.Columns(21)
.Txtisigec = DgExpedientes.Columns(22)
.CboEstCons = DgExpedientes.Columns(23)
.Txtu = DgExpedientes.Columns(24)
.Txtb = DgExpedientes.Columns(25)
.Txtr = DgExpedientes.Columns(26)
.Txtpi = DgExpedientes.Columns(27)
.Txtin = DgExpedientes.Columns(2
.Txti = DgExpedientes.Columns(29)
.Txtq = DgExpedientes.Columns(30)
.Txtz = DgExpedientes.Columns(31)
.Txtfs = DgExpedientes.Columns(32)
.Txtro = DgExpedientes.Columns(33)
.Txtob = DgExpedientes.Columns(34)
.TxtDesc = DgExpedientes.Columns(35)
.TxtResp = DgExpedientes.Columns(36)
'.DTPicker3 = DgExpedientes.Columns(37)
RsExpedientes.Update
End With
'End If
End Sub
'Private Sub DgHistorias_DBLClick()
' If DgHistorias.ApproxCount > 0 Then
' Modificar
' FrmModificarHistorias.Show vbModal
' End If
'End Sub
Private Sub Form_Load()
RsExpedientes.Close
RsExpedientes.Open "TBEXPEDIENTES", Conex, adOpenDynamic, adLockOptimistic
Set DgExpedientes.DataSource = RsExpedientes
If Not RsExpedientes.EOF Then Call LlenarDatos
End Sub
Private Sub TxtTit_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtTit_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtFi1.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub TxtFi1_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtFi1_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then TxtFuc2.SetFocus
End Sub
Private Sub TxtFi2_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then TxtFi3.SetFocus
End Sub
Private Sub TxtFi3_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then TxtFf1.SetFocus
End Sub
Private Sub TxtFf1_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtFf1_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then TxtFf2.SetFocus
End Sub
Private Sub TxtFf2_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then TxtFf3.SetFocus
End Sub
Private Sub TxtFf3_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then CboDataHis.SetFocus
End Sub
Private Sub CboDataHis_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub CboDataHis_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then TxtFond.SetFocus
End Sub
Private Sub TxtFond_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtFond_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtSec.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub TxtSec_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtSec_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtSerie.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub TxtSerie_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtSerie_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtLegC.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub TxtLegC_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtLegC_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtExpCua.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub TxtExpCua_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtExpCua_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtEst.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub TxtEst_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtEst_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then TxtSig.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub TxtSig_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub TxtSig_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Txtnfol.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub Txtnfol_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub Txtnfol_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Txtinsig.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub Txtinsig_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub Txtinsig_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then CboEstCons.SetFocus
Call Letra1(KeyAscii)
End Sub
Private Sub CboEstCons_Change()
If Trim(TxtTit) = "" And Fec1 = "" And Fec2 = "" And Trim(TxtCbodatahis) = "" And Trim(TxtFond) = "" And Trim(TxtSec) = "" And Trim(TxtSerie) = "" And Trim(TxtLegC) = "" And Trim(TxtExpCua) = "" And Trim(TxtEst) = "" And Trim(TxtSig) = "" And Trim(Txtnfol) = "" And Trim(Txtinsig) = "" And Trim(CboEstCons) = "" Then
LlenarDatos
End If
End Sub
Private Sub CboEstCons_KeyPress(KeyAscii As Integer)
Call Numero(KeyAscii)
If KeyAscii = 13 Then CmdBuscarExpedientes.SetFocus
End Sub
Sub LlenarDatos()
Set RsExpedientes = New ADODB.Recordset
RsExpedientes.CursorLocation = adUseClient
RsExpedientes.Open "Select * from TBEXPEDIENTES", Conex.ConnectionString, adOpenKeyset, adLockOptimistic
nnectionString , adOpenKeyset, adLockOptimistic
Set DgExpedientes.DataSource = RsExpedientes
End Sub
Private Sub Form_Unload(Cancel As Integer)
RsExpedientes.Close
End Sub
modulo
Public Conex As New ADODB.Connection
Public RsAcceso As New ADODB.Recordset
Public RsExpedientes As New ADODB.Recordset
Public RsConteoExpedientes As New ADODB.Recordset
Public RsUsuarios As New ADODB.Recordset
Public Usuario$
Public Const path As String = "\Archivos de programa\Proyecto1\"
'
Dim RsConexion As Recordset
Sub Main()
Set Conex = New ADODB.Connection
Conex.CursorLocation = adUseClient
With Conex
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "User Id=;data source=" + App.path + "\BDSIAGN.mdb;persist security info =false"
.Open
End With
FrmAcceso.Show
'FrmBien.Show
End Sub
Sub Letra1(Boton As Integer)
Select Case Boton
Case 65 To 90, 8, 32, 13
Case 97 To 122, 209, 241
Boton = Asc(UCase(Chr(Boton)))
Case Else
Boton = 0
End Select
End Sub
Sub Numero(Boton As Integer)
If Boton < Asc("0") Or Boton > Asc("9") Then
If Boton <> 8 And Boton <> 13 Then Boton = 0
End If
End Sub
Public Function Convertir_May_Min(ByVal Palabra As String) As String
Dim X
Palabra = Trim(LCase(Palabra))
For X = 1 To Len(Palabra)
If Mid(Palabra, X, 1) = Chr(32) Then Palabra = Mid(Palabra, 1, X - 1) + " " + UCase(Mid(Palabra, X + 1, 1)) + LCase(Mid(Palabra, X + 2, Len(Palabra)))
Next X
Convertir_May_Min = UCase(Left(Palabra, 1)) + Mid(Palabra, 2, Len(Palabra))
End Function
Puede publicar nuevos temas en este foro No puede responder a temas en este foro No puede editar sus mensajes en este foro No puede borrar sus mensajes en este foro No puede votar en encuestas en este foro
FAQ
Buscar
Grupos de Usuarios
Perfil
Entre para ver sus mensajes privados
Login
) Then
