RE:Problema en modulo de clase Base de datos
ESTA ES LA CLASE :
Private oCn As ADODB.Connection, oRs As ADODB.Recordset
Private msgError As String
'---------------Variables Cliente------------------------
Private lngId As Long
Private strNom_Cliente As String
Private strContacto_Cliente As String
Private strDir_Cliente As String
Private strLoc_Cliente As String
Private strPcia_Cliente As String
Private strCp_Cliente As String
Private strCuit_Cliente As String
Private strIns_Cliente As String
Private strTel_Cliente As String
Private strMail_Cliente As String
Private strComentarios As String
Private strFecha_Ingreso As String
Private strArchivos_Cliente As String
Private strTipo_Cliente As String
Private strConsulta_Cliente As String
'---------------------------------------------------------
Private Sub Class_Initialize()
Set oCn = New Connection
oCn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\LlinasDatabase.mdb;Persist Security Info=False"
oCn.Open
End Sub
Private Sub Class_Terminate()
oCn.Close
Set oCn = Nothing
End Sub
Public Function fModificacion_Cliente() As Boolean
Dim oCm As ADODB.Command
On Error GoTo herror
oCn.BeginTrans
Set oCm = New ADODB.Command
oCm.CommandType = adCmdStoredProc
oCm.CommandText = "SP_Cliente_UPDATE"
oCm.Parameters.Append oCm.CreateParameter("pId_Cliente", adInteger, adParamInput, lngId)
oCm.Parameters.Append oCm.CreateParameter("pNom_Cliente", adVarChar, adParamInput, 50, strNom_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pContacto_Cliente", adVarChar, adParamInput, 50, strContacto_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pDir_Cliente", adVarChar, adParamInput, 50, strDir_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pLoc_Cliente", adVarChar, adParamInput, 50, strLoc_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pPcia_Cliente", adVarChar, adParamInput, 50, strPcia_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pCp_Cliente", adVarChar, adParamInput, 50, strCp_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pCuit_Cliente", adVarChar, adParamInput, 50, strCuit_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pIns_Cliente", adVarChar, adParamInput, 50, strIns_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pTel_Cliente", adVarChar, adParamInput, 50, strTel_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pMail_Cliente", adVarChar, adParamInput, 50, strMail_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pComentarios", adVarChar, adParamInput, 50, strComentarios)
oCm.Parameters.Append oCm.CreateParameter("pFecha_Ingreso", adVarChar, adParamInput, 50, strFecha_Ingreso)
oCm.Parameters.Append oCm.CreateParameter("pArchivos_Cliente", adVarChar, adParamInput, 50, strArchivos_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pTipo_Cliente", adVarChar, adParamInput, 50, strTipo_Cliente)
oCm.Prepared = True
oCm.ActiveConnection = oCn
oCm.Execute
fModificacion_Cliente = True
oCn.CommitTrans
Exit Function
herror:
oCn.RollbackTrans
msgError = Err.Number & " - " & Err.Description
End Function
Public Function fAlta_Cliente() As Boolean
Dim oCm As ADODB.Command
On Error GoTo herror
oCn.BeginTrans
Set oCm = New ADODB.Command
oCm.CommandType = adCmdStoredProc
oCm.CommandText = "SP_Cliente_INSERT"
oCm.Parameters.Append oCm.CreateParameter("pNom_Cliente", adVarChar, adParamInput, 50, strNom_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pContacto_Cliente", adVarChar, adParamInput, 50, strContacto_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pDir_Cliente", adVarChar, adParamInput, 50, strDir_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pLoc_Cliente", adVarChar, adParamInput, 50, strLoc_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pPcia_Cliente", adVarChar, adParamInput, 50, strPcia_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pCp_Cliente", adVarChar, adParamInput, 50, strCp_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pCuit_Cliente", adVarChar, adParamInput, 50, strCuit_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pIns_Cliente", adVarChar, adParamInput, 50, strIns_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pTel_Cliente", adVarChar, adParamInput, 50, strTel_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pMail_Cliente", adVarChar, adParamInput, 50, strMail_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pComentarios", adVarChar, adParamInput, 50, strComentarios)
oCm.Parameters.Append oCm.CreateParameter("pFecha_Ingreso", adVarChar, adParamInput, 50, strFecha_Ingreso)
oCm.Parameters.Append oCm.CreateParameter("pArchivos_Cliente", adVarChar, adParamInput, 50, strArchivos_Cliente)
oCm.Parameters.Append oCm.CreateParameter("pTipo_Cliente", adVarChar, adParamInput, 50, strTipo_Cliente)
oCm.Prepared = True
oCm.ActiveConnection = oCn
oCm.Execute
fAlta_Cliente = True
oCn.CommitTrans
Exit Function
herror:
oCn.RollbackTrans
msgError = Err.Number & " - " & Err.Description
End Function
Public Function fBaja_Cliente() As Boolean
Dim oCm As ADODB.Command
On Error GoTo herror
oCn.BeginTrans
Set oCm = New ADODB.Command
oCm.CommandType = adCmdStoredProc
oCm.CommandText = "SP_Cliente_DELETE"
oCm.Parameters.Append oCm.CreateParameter("pId", adInteger, adParamInput, lngId)
oCm.Prepared = True
oCm.ActiveConnection = oCn
oCm.Execute
fBaja_Cliente = True
oCn.CommitTrans
Exit Function
herror:
oCn.RollbackTrans
msgError = Err.Number & "-" & Err.Description
End Function
Public Function fConsulta_Cliente() As Boolean
Dim oCm As ADODB.Command
On Error GoTo herror
Set oCm = New ADODB.Command
oCm.CommandType = adCmdStoredProc
oCm.CommandText = "Consulta_Cliente"
oCm.Parameters.Append oCm.CreateParameter("pNom_Cliente", adVarChar, adParamInput, 50, strNom_Cliente)
oCm.Prepared = True ' permite obviar el chequeo de la consulta y ejecutarla directamente osea darla como buena
oCm.ActiveConnection = oCn
oCm.ActiveConnection.CursorLocation = adUseClient
Set oRs = oCm.Execute
fConsulta_Cliente = True ' por defecto siempre esta en falso se lo asigno solo sino no se produzco un error
Exit Function
herror:
msgError = Err.Number & "-" & Err.Description
End Function
Public Property Get ptyError() As String
ptyError = msgError
End Property
Public Property Let ptyId_Cliente(ByVal vNewValue As Long)
lngId = vNewValue
End Property
Public Property Let ptyNom_Cliente(ByVal vNewValue As String)
strNom_Cliente = vNewValue
End Property
Public Property Let ptyContacto_Cliente(ByVal vNewValue As String)
strContacto_Cliente = vNewValue
End Property
Public Property Let ptyDir_Cliente(ByVal vNewValue As String)
strDir_Cliente = vNewValue
End Property
Public Property Let ptyLoc_Cliente(ByVal vNewValue As String)
strLoc_Cliente = vNewValue
End Property
Public Property Let ptyPcia_Cliente(ByVal vNewValue As String)
strPcia_Cliente = vNewValue
End Property
Public Property Let ptyCp_Cliente(ByVal vNewValue As String)
strCp_Cliente = vNewValue
End Property
Public Property Let ptyCuit_Cliente(ByVal vNewValue As String)
strCuit_Cliente = vNewValue
End Property
Public Property Let ptyIns_Cliente(ByVal vNewValue As String)
strIns_Cliente = vNewValue
End Property
Public Property Let ptyTel_Cliente(ByVal vNewValue As String)
strTel_Cliente = vNewValue
End Property
Public Property Let ptyMail_Cliente(ByVal vNewValue As String)
strMail_Cliente = vNewValue
End Property
Public Property Let ptyComentarios(ByVal vNewValue As String)
strComentarios = vNewValue
End Property
Public Property Let ptyFecha_Ingreso(ByVal vNewValue As String)
strFecha_Ingreso = vNewValue
End Property
Public Property Let ptyArchivos_Cliente(ByVal vNewValue As String)
strArchivos_Cliente = vNewValue
End Property
Public Property Let ptyTipo_Cliente(ByVal vNewValue As String)
strTipo_Cliente = vNewValue
End Property
Public Property Let ptyConsulta_Cliente(ByVal vNewValue As String)
strConsulta_Cliente = vNewValue
End Property
Public Property Get cGrilla() As ADODB.Recordset
Set cGrilla = oRs
End Property
GRACIAS POR TODO ESPERO ALGUNA RESPUESTA