Ayuda con conexion con objeto ado

vapirox
07 de Octubre del 2008
este es el codigo de mi proyecto, pero no me funciona la conexion, estoy conectado mediante el objeto ADODC..

[code]

Private Sub CmbRegion_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub CmbCondicion_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Sub HabilitarControles(Valor As Boolean)
CmbCondicion.Visible = Valor
CmbRegion.Visible = Valor
LblRegion.Visible = Valor
LblCondicion.Visible = Valor
CmbCondicion.Enabled = True
CmbRegion.Enabled = True
End Sub

Private Sub CmbSistema_Click()
Dim ID As String
ID = "SGA" 'ESTA VARIABLE PUEDE DEPENDER DE UN VALOR GLOBAL
If CmbSistema.Text = ID Then
HabilitarControles True
Else
HabilitarControles False
End If
End Sub

Private Sub CmbSistema_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub CmdAgregar_Click()
Mensaje = MsgBox("Desea Incluir un Nuevo Registro", vbYesNo, "Incluir")

'Sub Rutina que se activara en caso de que se genere un error al incluir registro

If Mensaje = vbYes Then
'Se habilitan todos los TextBox
TxtID.Enabled = True
TxtUsuario.Enabled = True
CmbSistema.Enabled = True
CmbRegion.Visible = False
CmbCondicion.Visible = False
LblRegion.Visible = False
LblCondicion.Visible = False
'Se blanquean los TexBox
TxtID = ""
TxtUsuario = ""
CmbSistema = ""
CmbRegion = ""
CmbCondicion = ""
'Se Habilitan y deshabilitan algunos botones
CmdAgregar.Enabled = False
CmdEliminar.Enabled = False
CmdSalir.Enabled = True
CmdGuardar.Enabled = True
AdoDatos.Enabled = False
CmdBuscar.Enabled = False
Mensaje = MsgBox("Introdusca los Datos y Pulse el Boton de [Guardar]")
'Se coloca el foco sobre el TexBox de Id
TxtID.SetFocus
'
'Sub-Rutina Errores
'
Errores:
If Err.Number <> 0 Then
Mensaje = MsgBox("Se ha Generado un Error:[" + Str(Err.Number) + "]-" + Err.Description, vbCritical, "Error")
Resume Next
End If
End If

End Sub

Private Sub CmdBDCUS_Click()
CmdBDCUS.Visible = False
ImgLogo.Visible = False
LblID.Visible = True
LblUsuario.Visible = True
LblSistema.Visible = True
LblRegion.Visible = True
LblCondicion.Visible = True
TxtID.Visible = True
TxtUsuario.Visible = True
CmbRegion.Visible = True
CmbCondicion.Visible = True
AdoDatos.Visible = True
CmdAgregar.Visible = True
CmdEliminar.Visible = True
CmdGuardar.Visible = True
TxtID.Enabled = False
TxtUsuario.Enabled = False
CmbRegion.Enabled = False
CmbCondicion.Enabled = False
CmdBuscar.Visible = True
CmbSistema.Visible = True
CmbSistema.Enabled = False
End Sub

Private Sub CmdBuscar_Click()
Dim Criterio As String
Dim Busqueda As String
'Set VarRecBd = New ADODB.Recordset
Busqueda = InputBox("Introduce ID a buscar", "Búsqueda por ID")

With AdoDatos.Recordset
Criterio = "ID LIKE '*" & Busqueda & "*'"
If Busqueda = "" Then
Exit Sub
Else
.MoveNext
If Not .EOF Then
.Find Criterio
End If
If Not .EOF Then
.Find Criterio
Else
.MoveFirst
.Find Criterio
If .EOF Then
.MoveLast
MsgBox "Dato no encontrado", vbInformation, "¡Aviso!"
End If
End If
End If
End With
End Sub

Private Sub CmdEliminar_Click()
'Rutina que se utiliza para eliminar
'Sub rutina que se utilizara en caso de que se genere un error al eliminar un registro

'StrCnn es la variable donde se almacena la coneccion con la base de datos
Strcnn = AdoDatos.ConnectionString
'VarRecBd es la variable que almacena la imagen de la estructura de la tabla (DatosCus)
Set VarRecBD = New ADODB.Recordset
'StrSql es la variable en donde se almacena el nombre de la tabla y el campo clave
StrSql = "Select *From DatosCus Where ID = " + TxtID.Text
'Se procede a trabajar con la imagen de la estructura de la tabla
With VarRecBD
'Se procede a aperturar la coneccion con la tabla y la base de datos
.Open StrSql, Strcnn, adOpenDynamic, adLockOptimistic
'Si encuentra la ID que es el campo clave debe preguntar si lo desea eliminar
If Not .EOF Then
Mensaje = MsgBox("Desea Eliminar el Registro", vbYesNo, "Eliminar")
'Si la respuesta es afirmativa procedera a elimiar el registro
If Mensaje = vbYes Then
.Delete
Mensaje = MsgBox("El Registro fue Eliminado", vbInformation, "Aviso")
'Se Blanquean todos los TexBox
TxtID = ""
TxtUsuario = ""
CmbSistema = ""
CmbRegion = ""
CmbCondicion = ""
'Se Refresca o actualiza el objeto Ado
AdoDatos.Refresh
End If
'Si no encuentra la ID
Else
Mensaje = MsgBox("El Registro no Existe", vbInformation, "Eliminar")
End If
'Se Cierra la coneccion con la base de datos
.Close
End With
'
'Sub-Rutina Errores
'
Errores:
If Err.Number <> 0 Then
Mensaje = MsgBox("Se ha generado un error: [" + Str(Err.Number) + "] - " + Err.Description, vbCritical, "Error")
Resume Next
End If
End Sub

Private Sub CmdGuardar_Click()
'Sub rutina que se activara en caso de que se genere un error al guardar registro

'En la variable StrCnn se almacena la conexion con el objeto AdoDatos
Strcnn = AdoDatos.ConnectionString
'En la variable VarRecBd se almacena una imagen de la estructura de la tabla
Set VarRecBD = New ADODB.Recordset
'En la variable StrSql se almacena el nombre de la tabla a utilizar
StrSql = "Select *From DatosCus Where ID = " + TxtID.Text + " AND Sistema = " + CmbSistema.Text
'Con la instruccion With VarRecBd se le indica con que estructura se va a trabajar
With VarRecBD
'Se apertura la conexion con las base de datos y la tabla
.Open StrSql, Strcnn, adOpenDynamic, adLockOptimistic
'Se pregunta si es fin de archivo con la intencion de que la si la ID existe envia un mensaje informando al usuario de que esa ID ya existe
If .EOF Then
'Como la ID no fue encontrada se va a crear
.AddNew
'Se traslada lo que esta en los TexBox a los campos de la tabla
.Fields("ID").Value = TxtID.Text
.Fields("Usuario").Value = TxtUsuario.Text
.Fields("Sistema").Value = CmbSistema.Text
.Fields("Region").Value = CmbRegion.Text
.Fields("Condicion").Value = CmbCondicion.Text
'Se procede a guardar el registro en la tabla
.Update
'Se envia un mensaje para notificar que se guardo el registro
Mensaje = MsgBox("Registro Guardado", vbInformation, "Guardar")
'Se habilitan algunos botones
CmdAgregar.Enabled = True
CmdGuardar.Enabled = False
CmdEliminar.Enabled = True
CmdSalir.Enabled = True
AdoDatos.Enabled = True
CmdBuscar.Enabled = True
AdoDatos.Refresh
Else
'Si la ID existe se le notifica al usuario a travez de un mensaje
Mensaje = MsgBox("ID ya Existe", vbInformation, "Existe")
'Se mostrara los datos por pantalla los cuales podra modificar si asi lo desea
.Fields("ID").Value = TxtID.Text
.Fields("Usuario").Value = TxtUsuario.Text
.Fields("Sistema").Value = CmbSistema.Text
.Fields("Region").Value = CmbRegion.Text
.Fields("Condicion").Value = CmbCondicion.Text
.Update
Mensaje = MsgBox("El Registro fue Actualizado", vbInformation, "Actualiza")
CmdGuardar.Enabled = False
AdoDatos.Refresh
End If
'Se cierra la conexion
.Close
'Se Termina el With VarRecBd
End With
'
'Sub-Rutina Errores
'
Errores:
If Err.Number <> 0 Then
Mensaje = MsgBox("Se ha Generado un Error: [" + Str(Err.Number) + " ] -" + Err.Description, vbCritical, "Error")
Resume Next
End If
End Sub

Private Sub CmdSalir_Click()
Mensaje = MsgBox("Desea Salir del Formulario", vbYesNo, "SALIR")
If Mensaje = vbYes Then
'Se descarga el formulario
Unload Me
Mensaje = MsgBox("Hasta Luego ", vbInformation, "Aviso")
End
End If
End Sub

Private Sub Form_Load()
HabilitarControles False
'Mensaje de Bienvenida
Mensaje = MsgBox("Bienvenido a Base De Datos CUS", vbInformation, "Programacion y Diseño Miguel Batista")
'Se deshabilitan botones
CmdGuardar.Enabled = False
LblID.Visible = False
LblUsuario.Visible = False
LblSistema.Visible = False
LblRegion.Visible = False
LblCondicion.Visible = False
TxtID.Visible = False
TxtUsuario.Visible = False
CmbRegion.Visible = False
CmbCondicion.Visible = False
AdoDatos.Visible = False
CmdAgregar.Visible = False
CmdEliminar.Visible = False
CmdGuardar.Visible = False
CmdBuscar.Visible = False
CmbSistema.Visible = False
End Sub

Private Sub TimerFyH_Timer()
LblTime.Caption = Time$
LblDate.Caption = Date$
End Sub
[/code]

si me pueden ayudar se los agradeceria

vapirox
07 de Octubre del 2008
lo que no me funciona del codigo, es la parte de guardar..


vapirox
07 de Octubre del 2008
lo que no me funciona del codigo, es la parte de guardar..