Hola, Hola, aqui una vez más Lagunax molestando un poco a la comunidad, me ha surgido un error muy extraño, ojala que alguien pueda ayudarme a resolverlo.
Estoy realizando la sección de editar-eliminar registros de un pequeño sistema que utiliza BD access. Mediante un combobox y un text que sirve de filtro, despliego los datos de la BD en un MSHFlexgrid. Cuando hago click en una fila obtengo el ID de esos datos , el cual utilizo para modificar y eliminar la información.
He logrado realizar con exito el boton de editar [Command1] pero me surge un problema con el boton de eliminar rgistro [aqui Command4].
Aclaro que [Command2] limpia los text y combo boxes, [Command1] copia los valores para emular un boton "deshacer".
En [Command4] realizo una coneccion a la BD, un select, y luego recorro el recorset para encontar los campos que corresponden con el indice que obtuve del MSHFlexgrid1 (variable pasar_id). El problema surge cuando presiono el botón de eliminar, manda "Error de compilación: Loop sin Do". He intentado con F8 (paso a paso) pero al momento de presionar el botón se corta, por lo que no puedo verificar si simplemente no reconoce el Do o existe otro problema.
Option Explicit
Public bool As Boolean
Public bool2 As Boolean
Public auxi_grid As String
Public pasar_id As Integer
Public Numero As Integer
Public ident As Integer
Public auxi As Integer
Public copia_id As Integer
Public copia_nombre As String
Public copia_descripcion As String
Public copia_solucion_1 As String
Public cn As ADODB.Connection
Public rst As ADODB.Recordset
Sub Conectar()
' Crea una nueva conexión y un recordset
Set cn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
rst.CursorLocation = adUseClient
' abre la base de datos DIRECCION ANTERIOR
' cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
' "Source=C:Program FilesMicrosoft " & _
' "Visual StudioVB98SISTEMA BUSQUEDAAplicacion.MDB;Persist Security Info=False"
'DIRECCION NUEVA DEL SERVIDOR \XOA008
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data " & _
"Source=\Xoa008COMPARTIDO SISTEMASSistema " & _
"de Registro & Solución de ProblemasBase de DatosAplicacion.MDB;Persist Security Info=False"
End Sub
Sub Desconectar()
'MOSTRAR LA LISTA DE SOLUCIONES EN TEXT3.TEX
' Form6.Text3.Text = rst("Solucion_1")
'*******************************************
rst.Close
cn.Close
Set rst = Nothing
Set cn = Nothing
End Sub
Private Sub Combo1_Click()
Call Conectar
rst.Open "SELECT ID,Nombre,Descripcion FROM TablaAplicacion WHERE Nombre Like '%" & _
Combo1.Text & "%'", cn, adOpenStatic, adLockOptimistic
' Muestra los datos en el FlexGrid
Set MSHFlexGrid1.DataSource = rst
' Visualiza la cantidad de registros filtrados
Me.Caption = "Peugeot - Registros encontrados: " & CStr(rst.RecordCount)
Call Desconectar
End Sub
Private Sub Command1_Click()
'MARZO 5 - EVITAR ERROR AL PULSAR GUARDAR CON CAMPOS EN BLANCO
If Text3.Text = "" And Text5.Text = "" And Text6.Text = "" And Combo2.Text = "" Then
MsgBox ("No hay Datos para Modificar.")
Else
Call Conectar
rst.Open "SELECT ID,Nombre,Descripcion,Solucion_1 FROM TablaAplicacion WHERE ID Like '%" & _
Text4.Text & "%'", cn, adOpenStatic, adLockOptimistic
If rst.EOF = True Then
Beep
Else
Do While bool2 = False
If rst.Fields("ID") = pasar_id Then '¿¿¿¿¿¿ crear variable para copiar
rst.Fields("Nombre") = Combo2.Text
rst.Fields("Descripcion") = Text5.Text
rst.Fields("Solucion_1") = Text6.Text
rst.Update
MsgBox ("Se han guardado los cambios.")
bool2 = True
Else
rst.MoveNext
End If
Loop
End If
rst.MoveFirst
Call Desconectar
bool2 = False
MSHFlexGrid1.Clear
End If
'Call copy_auxi
End Sub
Private Sub Command2_Click()
Form9.Hide
'MARZO 5 - LIMPIEZA AL SALIR DE EDITAR/BORRAR
MSHFlexGrid1.Clear
MSHFlexGrid1.Refresh
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
'Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Combo1.Text = ""
Combo2.Text = ""
Form1.Show
End Sub
Private Sub Command3_Click()
'AGREGADO DEL 5 DE MARZO
Combo2.Text = copia_nombre
Text5.Text = copia_descripcion
Text6.Text = copia_solucion_1
'Call local_clear_auxi
End Sub
//////////////////////////////////////////////////////////////////////////////////////////////////
AQUI INICIA EL PROBLEMA
//////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub Command4_Click()
'MARZO 5
'On Error Resume Next
'Se utiliza la línea On Error Resume Next para indicarle a Visual Basic que siga ejecutando
'la forma, aún cuando ocurra un error de ejecución
Call Conectar
rst.Open "SELECT ID,Nombre,Descripcion,Solucion_1 FROM TablaAplicacion WHERE ID Like '%" & _
Text4.Text & "%'", cn, adOpenStatic, adLockOptimistic
If rst.EOF = True Then
Beep
Else
'Do While bool2 = False '////// ESTE ES EL CICLO QUE NO RECONOCE
Do Until bool2 = True
If rst.Fields("ID") = pasar_id Then
'MARZ0 5 MIDIFICADO
'rst.Fields("Nombre") = Combo2.Text
'rst.Fields("Descripcion") = Text5.Text
'rst.Fields("Solucion_1") = Text6.Text
If MsgBox("Se va a eliminar el Registro, ¿Desea continuar?", vbExclamation + vbYesNo, "Eliminacion de Registros") = vbYes Then
rst.Delete
rst.Requery
rst.MoveNext
'PARA EVITAR QUE AL ELIMINAR EL CURSOR DESPLIEGUE EL MISMO REGISTRO ELIMINADO
'A PESAR DE QUE EL RECORDSET YA AVANZO
'CALCULAR EL AVANCE DEL RECORSET
Text3.Text = rst.Fields("ID")
Combo2.Text = rst.Fields("Nombre")
Text5.Text = rst.Fields("Descripcion")
Text6.Text = rst.Fields("Solucion_1")
If rst.EOF Then
rst.MoveLast
End If
MsgBox ("Registro Eliminado con Éxito.")
bool2 = True
Else
rst.MoveNext
End If
Loop
End If
rst.MoveFirst
Call Desconectar
bool2 = False
MSHFlexGrid1.Clear
End Sub
//////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////
Private Sub Form_Load()
MSHFlexGrid1.Clear
With MSHFlexGrid1
.SelectionMode = flexSelectionByRow
.FixedCols = 0
.ColWidth(0) = 700
.ColWidth(1) = 2000
.ColWidth(2) = 5000
' .ColWidth(3) = 4000
' .ColWidth(4) = 4000
End With
Text2.Text = ""
' Text3.Text = ""
End Sub
Private Sub MSHFlexGrid1_Click()
'///////////////////////////////////////////////////////////////////
'CAMBIAR CADENAS STRING A INTEGER
'Dim Cadena As String, Numero As Integer
'Cadena = "12345.25"
'Numero = CInt(Val(Cadena)) 'Esto te cambia la cadena a un numero entero
Text1.Text = MSHFlexGrid1.Text
auxi_grid = MSHFlexGrid1.Text
Numero = CInt(Val(auxi_grid))
Text4.Text = Numero
Form7.Text1.Text = ""
Call Conectar
'CAMBIOS NUEVOS agregamos Solucion
rst.Open "SELECT ID,Nombre,Descripcion,Solucion_1 FROM TablaAplicacion WHERE ID Like '%" & _
Text4.Text & "%'", cn, adOpenStatic, adLockOptimistic
' Para acceder a un campo:
If rst.EOF = True Then
Form7.Text1.Text = ""
Else
'CAMBIOS NUEVOS Adodc1.RecordSource = "SELECT * FROM TablaAplicacion"
'CAMBIOS NUEVOS Adodc1.Refresh
'/// With Adodc1.Recordset
'/// If .EOF And .BOF Then
'/// auxi = 0
'/// Else
If MSHFlexGrid1.Text = "" Then
MsgBox "La Tabla esta Vacia"
Else
Do While bool = False
'CAMBIOS NUEVOS If Adodc1.Recordset.Fields("ID") = Text4.Text Then
If rst.Fields("ID") = Text4.Text Then
Text3.Text = ""
Combo2.Text = ""
Text5.Text = ""
Text6.Text = ""
Text3.Text = rst.Fields("ID")
Combo2.Text = rst.Fields("Nombre")
Text5.Text = rst.Fields("Descripcion")
Text6.Text = rst.Fields("Solucion_1")
bool = True
pasar_id = rst.Fields("ID")
'CAMBIO RECIENTE HOY 5 MARZO
Call local_clear_auxi
Call local_copy_auxi
Else
'CAMBIOS NUEVOS Adodc1.Recordset.MoveNext
rst.MoveNext
End If
Loop
End If
'/// End If
'/// End With
'CAMBIOS NUEVOS Adodc1.Recordset.MoveFirst 'CAMBIO RECIENTE
End If
rst.MoveFirst
Call Desconectar
auxi_grid = ""
Numero = 0
Text4.Text = ""
bool = False
End Sub
Private Sub Text1_GotFocus()
'Text1.Text = ""
End Sub
Private Sub Text2_Change()
' conecta
Call Conectar
bool = False
' Ejecuta la consulta SQL
'SENTENCIA SQL ORIGINAL
' rst.Open "SELECT ID,Nombre,Descripcion FROM TablaAplicacion WHERE Descripcion Like '%" & _
' Text2.Text & "%'", cn, adOpenStatic, adLockOptimistic
rst.Open "SELECT ID,Nombre,Descripcion FROM TablaAplicacion WHERE Descripcion Like '%" & Text2.Text & "%' And Nombre Like '" & Combo1.Text & "'", cn, adOpenStatic, adLockOptimistic
' ' Para acceder a un campo:
If rst.EOF = True Then
' Text3.Text = "" borrar text1
Text1.Text = ""
Else
'ULTIMA MODIFICIACION ADODC******************************************************
ident = rst("ID")
Adodc1.RecordSource = "SELECT * FROM TablaAplicacion"
Adodc1.Refresh
Do While bool = False
If Adodc1.Recordset.Fields("ID") = ident Then
'Text3.Text = Adodc1.Recordset.Fields("Solucion_1")
'IMPRIME SOLUCION EN TEXT3.TEXT CUANDO FILTRAS INFO
bool = True
Else
Adodc1.Recordset.MoveNext
End If
Loop
'*******************************************************************************
' GOOD Text3.Text = rst("Solucion_1")
End If
' Enlaza el FlexGRid
Set MSHFlexGrid1.DataSource = rst
' Cantidad de registros
Me.Caption = "Registros encontrados: " & CStr(rst.RecordCount)
' Desconecta de la base de datos
Call Desconectar
If Text2.Text = "" Then
'Text3.Text = "" borrar text1
Text1.Text = ""
End If
End Sub
Private Sub Text2_GotFocus()
Text2.Text = ""
End Sub
''MODIFICACION RECIENTE 5 de marzo////////////////////////////////////////////
' COPIA VARIABLES AUXI PARA BOTON DESHACER
Private Sub local_copy_auxi()
'copia_id = TxtID.Text
copia_nombre = Combo2.Text
copia_descripcion = Text5.Text
copia_solucion_1 = Text6.Text
End Sub
Private Sub local_clear_auxi()
'copia_id = 0
copia_nombre = ""
copia_descripcion = ""
copia_solucion_1 = ""
End Sub
Incluso he probado en vez de un "Do While" un "Do Until" (esta en comentarios) pero sigue sin reconocer el Do. Alguien podría ayudarme, porfavor.
De antemano Gracias.
