Hola a tods tengo un problemon con una base de datos y el problema es este
variable de tipo object o la variable de bloque with no esta establecida
y mi codigo es el siguiente
Option Explicit
Dim idx As Integer
Dim accion As String
Private Sub cmd_exit_Click()
accion = "exit"
Listar_Usuarios
Unload frmUsuarios
End Sub
Private Sub cmdAyuda_Click()
ShellExecute Me.hWnd, "open", "c:\Archivos de Programa\IASS625\Ayuda\Administracion de usuarios.pdf", "", "", 3
End Sub
Private Sub cmdCancel_Click()
On Error GoTo ErrCancel
cmdEditar.Enabled = True
cmdNew.Enabled = True
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdDelete.Enabled = True
cmd_exit.Enabled = True
lista_usuarios.Enabled = True
AdoPermisos.Refresh
txtUser = ""
txtClave = ""
txtUser.Enabled = False
txtClave.Enabled = False
For idx = 0 To 5
Check1(idx).Enabled = False
Check1(idx).Value = 0
Next
Listar_Usuarios
Exit Sub
ErrCancel:
MsgBox Err.Description, vbInformation, "Información de error"
End Sub
Private Sub cmdDelete_Click()
On Error GoTo errorDelete
If (MsgBox("Desea eliminar al usuario " & txtUser & "?", vbYesNo, "Eliminar usuario") = vbYes) Then
txtUser = ""
txtClave = ""
For idx = 0 To 5
Check1(idx).Value = 0
Next
cmdEditar.Enabled = True
cmdNew.Enabled = True
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdDelete.Enabled = True
cmd_exit.Enabled = True
lista_usuarios.Enabled = True
If AdoPermisos.Recordset.BOF And AdoPermisos.Recordset.EOF Then
MsgBox "Usuario no existe." & vbCrLf & _
"A continuación se dara de alta usuario admin, clave 1234", vbInformation, "No existen usuarios"
Else
AdoPermisos.Recordset.Delete
AdoPermisos.Recordset.Update
End If
End If
Listar_Usuarios
Exit Sub
errorDelete:
If Err.Number = 3021 Then
MsgBox "Seleccione un usuario", vbInformation, "Eliminar Usuario"
Else
MsgBox Err.Description & vbCrLf & Err.Number, vbInformation, "Información"
End If
End Sub
Private Sub Listar_Usuarios()
On Error GoTo ErrorListar
lista_usuarios.Clear
If AdoPermisos.Recordset.BOF And AdoPermisos.Recordset.EOF Then
'Si no existe ningun usuario crear usuario administrador
'Nombre de usuario admin
'Contraseña 1234
With AdoPermisos.Recordset
.AddNew
!Usuario = "admin"
!clave = "1234"
!bypass = True
!discriminar = True
!PARAMETROS = True
!MODELOS = True
!ip = True
!admin = True
.Update
End With
Listar_Usuarios
'Si va salir de sesion
If accion = "exit" Then
MsgBox "Se creo el usuario: admin" & vbCrLf & "Clave: " & "1234", vbInformation, "Datos de usuario"
End If
Else
AdoPermisos.Recordset.MoveFirst
Do Until AdoPermisos.Recordset.EOF
lista_usuarios.AddItem AdoPermisos.Recordset!Usuario
AdoPermisos.Recordset.MoveNext
Loop
lista_usuarios.ListIndex = 0
End If
Exit Sub
ErrorListar:
MsgBox Err.Description, vbInformation, "Información de error"
End Sub
Private Sub cmdEditar_Click()
cmdEditar.Enabled = False
cmdNew.Enabled = False
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdDelete.Enabled = True
cmd_exit.Enabled = True
lista_usuarios.Enabled = True
txtUser.Enabled = True
txtClave.Enabled = True
For idx = 0 To 5
Check1(idx).Enabled = True
Next
txtUser.SetFocus
End Sub
Private Sub cmdNew_Click()
accion = "N"
cmdEditar.Enabled = False
cmdNew.Enabled = False
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdDelete.Enabled = False
cmd_exit.Enabled = True
lista_usuarios.Enabled = False
cmdEditar_Click
txtUser = ""
txtClave = ""
For idx = 0 To 5
Check1(idx).Value = 0
Next
txtUser.SetFocus
End Sub
Private Sub cmdSave_Click()
On Error GoTo ErrSave
If txtUser = "" Or txtClave = "" Then
MsgBox "Complete datos", vbCritical, "Guardar"
Else
cmdEditar.Enabled = True
cmdNew.Enabled = True
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdDelete.Enabled = True
cmd_exit.Enabled = True
lista_usuarios.Enabled = True
'Guardar valores en BD
With AdoPermisos.Recordset
'Si se crea un nuevo usuario
If accion = "N" Then
.AddNew
accion = ""
End If
!Usuario = txtUser
!clave = txtClave
If Check1(0).Value = 0 Then
!bypass = False
Else
!bypass = True
End If
If Check1(1).Value = 0 Then
!discriminar = False
Else
!discriminar = True
End If
If Check1(2).Value = 0 Then
!PARAMETROS = False
Else
!PARAMETROS = True
End If
If Check1(3).Value = 0 Then
!MODELOS = False
Else
!MODELOS = True
End If
If Check1(4).Value = 0 Then
!ip = False
Else
!ip = True
End If
If Check1(5).Value = 0 Then
!admin = False
Else
!admin = True
End If
End With
AdoPermisos.Recordset.Update
txtUser.Enabled = False
txtClave.Enabled = False
For idx = 0 To 5
Check1(idx).Enabled = False
Next
Listar_Usuarios
End If
Exit Sub
ErrSave:
MsgBox Err.Description, vbInformation, "Información de error"
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
Listar_Usuarios
cmdEditar.Enabled = True
cmdNew.Enabled = True
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdDelete.Enabled = True
cmd_exit.Enabled = True
lista_usuarios.Enabled = True
End Sub
Private Sub lista_usuarios_Click()
On Error GoTo ErrLista_usuarios
'Filtrar usuario
AdoPermisos.Recordset.MoveFirst
AdoPermisos.Recordset.Find "usuario = '" & lista_usuarios.Text & "'", 0, adSearchForward
'Mostrar valores almacenados
With AdoPermisos.Recordset
txtUser = !Usuario
txtClave = !clave
If !bypass = True Then
Check1(0).Value = 1
Else
Check1(0).Value = 0
End If
If !discriminar = True Then
Check1(1).Value = 1
Else
Check1(1).Value = 0
End If
If !PARAMETROS = True Then
Check1(2).Value = 1
Else
Check1(2).Value = 0
End If
If !MODELOS = True Then
Check1(3).Value = 1
Else
Check1(3).Value = 0
End If
If !ip = True Then
Check1(4).Value = 1
Else
Check1(4).Value = 0
End If
If !admin = True Then
Check1(5).Value = 1
Else
Check1(5).Value = 0
End If
End With
Exit Sub
ErrLista_usuarios:
MsgBox Err.Description, vbInformation, "Información de error"
End Sub
