 Clases
aqui te pongo un ejemplo de como se usan las clases:
Creo la clase :
'**********Inicio de la clase*****************
Option Explicit
'Date Created - 22/12/2006 01:31:46 p.m.
'Created by - Miguel Alejandro Lopez Montaño
Private Const MODULE_NAME = "clstblMedios"
Private m_nId As Integer
Private m_sMedio As String
Private m_sObservacion As String
Private m_bEstatus As Single
Private m_nIdUsuarioReg As Integer
Private m_dtFechaReg As Date
Private m_nIdUsuarioMod As Integer
Private m_dtFechaMod As Date
Private m_nIdUsuarioCan As Integer
Private m_dtFechaCan As Date
Private mFcMedios As Integer '// FcMedios property.
Public Property Let Id(NewId As Integer)
m_nId = NewId
End Property
Public Property Get Id() As Integer
Id = m_nId
End Property
Public Property Let Medio(NewMedio As String)
m_sMedio = NewMedio
End Property
Public Property Get Medio() As String
Medio = m_sMedio
End Property
Public Property Let Observacion(NewObservacion As String)
m_sObservacion = NewObservacion
End Property
Public Property Get Observacion() As String
Observacion = m_sObservacion
End Property
Public Property Let Estatus(NewEstatus As Single)
m_bEstatus = NewEstatus
End Property
Public Property Get Estatus() As Single
Estatus = m_bEstatus
End Property
Public Property Let IdUsuarioReg(NewIdUsuarioReg As Integer)
m_nIdUsuarioReg = NewIdUsuarioReg
End Property
Public Property Get IdUsuarioReg() As Integer
IdUsuarioReg = m_nIdUsuarioReg
End Property
Public Property Let FechaReg(NewFechaReg As Date)
m_dtFechaReg = NewFechaReg
End Property
Public Property Get FechaReg() As Date
FechaReg = m_dtFechaReg
End Property
Public Property Let IdUsuarioMod(NewIdUsuarioMod As Integer)
m_nIdUsuarioMod = NewIdUsuarioMod
End Property
Public Property Get IdUsuarioMod() As Integer
IdUsuarioMod = m_nIdUsuarioMod
End Property
Public Property Let FechaMod(NewFechaMod As Date)
m_dtFechaMod = NewFechaMod
End Property
Public Property Get FechaMod() As Date
FechaMod = m_dtFechaMod
End Property
Public Property Let IdUsuarioCan(NewIdUsuarioCan As Integer)
m_nIdUsuarioCan = NewIdUsuarioCan
End Property
Public Property Get IdUsuarioCan() As Integer
IdUsuarioCan = m_nIdUsuarioCan
End Property
Public Property Let FechaCan(NewFechaCan As Date)
m_dtFechaCan = NewFechaCan
End Property
Public Property Get FechaCan() As Date
FechaCan = m_dtFechaCan
End Property
Public Sub Delete()
Dim sSQL As String
Dim CMD As ADODB.Command
Dim nRowsAffected As Long
On Error GoTo AccessTblMediosDeleteError
sSQL = "DELETE FROM tblMedios"
sSQL = sSQL & " WHERE"
sSQL = sSQL & " Id = " & m_nId
Set CMD = New ADODB.Command
With CMD
.ActiveConnection = DemiData.cnCentral
.CommandText = sSQL
.CommandType = adCmdText
.Execute nRowsAffected
End With
AccessTblMediosDeleteExit:
Exit Sub
AccessTblMediosDeleteError:
Call SysException.Error(MODULE_NAME, "Delete")
Resume AccessTblMediosDeleteExit
End Sub
Public Function Insert() As Boolean
Dim sSQL As String
Dim CMD As ADODB.Command
Dim nRowsAffected As Long
Insert = False
On Error GoTo AccessTblMediosInsertError
sSQL = "INSERT INTO tblMedios ("
sSQL = sSQL & " Id,"
sSQL = sSQL & " Medio,"
sSQL = sSQL & " Observacion,"
sSQL = sSQL & " Estatus,"
sSQL = sSQL & " idUsuarioReg,"
sSQL = sSQL & " FechaReg"
sSQL = sSQL & ") VALUES ("
sSQL = sSQL & " " & m_nId & ","
sSQL = sSQL & " " & "'" & m_sMedio & "'" & ","
sSQL = sSQL & " " & "'" & m_sObservacion & "'" & ","
sSQL = sSQL & " " & m_bEstatus & ","
sSQL = sSQL & " " & m_nIdUsuarioReg & ","
sSQL = sSQL & " " & "'" & Format(m_dtFechaReg, "dd/mm/yyyy HH:MM AM/PM") & "'" & ""
sSQL = sSQL & ")"
Set CMD = New ADODB.Command
With CMD
.ActiveConnection = DemiData.cnCentral
.CommandText = sSQL
.CommandType = adCmdText
.Execute nRowsAffected
End With
Insert = True
AccessTblMediosInsertExit:
Exit Function
AccessTblMediosInsertError:
Call SysException.Error(MODULE_NAME, "Insert")
Resume AccessTblMediosInsertExit
End Function
Public Function Update() As Boolean
Dim sSQL As String
Dim CMD As ADODB.Command
Dim nRowsAffected As Long
Update = False
On Error GoTo AccessTblMediosUpdateError
sSQL = "UPDATE tblMedios"
sSQL = sSQL & " SET"
sSQL = sSQL & " Medio = " & "'" & m_sMedio & "'" & ","
sSQL = sSQL & " Observacion = " & "'" & m_sObservacion & "'" & ","
If m_bEstatus Then
sSQL = sSQL & " idUsuarioMod = " & m_nIdUsuarioMod & ","
sSQL = sSQL & " FechaMod = '" & Format(m_dtFechaMod, "dd/mm/yyyy HH:MM AM/PM") & "'"
Else
sSQL = sSQL & " idUsuarioCan = " & m_nIdUsuarioMod & ","
sSQL = sSQL & " FechaCan = " & "'" & Format(m_dtFechaMod, "dd/mm/yyyy HH:MM AM/PM") & "'"
End If
sSQL = sSQL & " WHERE "
sSQL = sSQL & " Id = " & m_nId
Set CMD = New ADODB.Command
With CMD
.ActiveConnection = DemiData.cnCentral
.CommandText = sSQL
.CommandType = adCmdText
.Execute nRowsAffected
End With
Update = True
AccessTblMediosUpdateExit:
Exit Function
AccessTblMediosUpdateError:
Call SysException.Error(MODULE_NAME, "Update")
Resume AccessTblMediosUpdateExit
End Function
Private Function GetDataFolio() As Boolean
On Error GoTo FOLIOGetDataError
Dim sSQL As String
Dim RS As ADODB.Recordset
Const FOLIO_FOLIO = 0
GetDataFolio = False
Set RS = New ADODB.Recordset
sSQL = "SELECT"
sSQL = sSQL & " F_cMedios"
sSQL = sSQL & " FROM FoliosSys"
Set RS.ActiveConnection = DemiData.cnCentral
RS.Open sSQL
If RS.RecordCount Then
mFcMedios = inCaseNull(RS!f_cMedios)
GetDataFolio = True
End If
FOLIOGetDataExit:
If Not RS Is Nothing Then
If RS.State = adStateOpen Then
RS.Close
End If
Set RS = Nothing
End If
Exit Function
FOLIOGetDataError:
Call SysException.Error(MODULE_NAME, "Tomar Datos")
Resume FOLIOGetDataExit
End Function
Private Function UpdateFolio() As Boolean
On Error GoTo FOLIOUpdateError
Dim sSQL As String
Dim CMD As ADODB.Command
Dim nRowsAffected As Long
UpdateFolio = False
sSQL = "UPDATE FoliosSys"
sSQL = sSQL & " SET"
sSQL = sSQL & " F_cmedios = " & mFcMedios + 1
Set CMD = New ADODB.Command
With CMD
.ActiveConnection = DemiData.cnCentral
.CommandText = sSQL
.CommandType = adCmdText
.Execute nRowsAffected
End With
UpdateFolio = True
FOLIOUpdateExit:
Exit Function
FOLIOUpdateError:
Call SysException.Error(MODULE_NAME, "Actualizar Datos")
Resume FOLIOUpdateExit
End Function
Public Function Incrementar() As Boolean
On Error GoTo Incrementar_Error
Incrementar = False
If GetDataFolio Then
If UpdateFolio Then
Incrementar = True
End If
End If
Incrementar_Done:
Exit Function
Incrementar_Error:
Call SysException.Error(MODULE_NAME, "Incrementar")
Resume Incrementar_Done
End Function
Public Function TomarFolio() As Long
On Error GoTo TomarFolio_Error
TomarFolio = 0
If GetDataFolio Then
TomarFolio = mFcMedios
End If
TomarFolio_Done:
Exit Function
TomarFolio_Error:
Call SysException.Error(MODULE_NAME, "TomarFolio")
Resume TomarFolio_Done
End Function
Public Property Let FcMedios(ByVal vFcMedios As Integer)
On Error GoTo Let_FcMedios_Error
mFcMedios = vFcMedios
Let_FcMedios_Done:
Exit Property
Let_FcMedios_Error:
Call SysException.Error(MODULE_NAME, "Let_FcMedios")
Resume Let_FcMedios_Done
End Property
Public Property Get FcMedios() As Integer
On Error GoTo Get_FcMedios_Error
FcMedios = mFcMedios
Get_FcMedios_Done:
Exit Property
Get_FcMedios_Error:
Call SysException.Error(MODULE_NAME, "Get_FcMedios")
Resume Get_FcMedios_Done
End Property
'*************Fin de la clase**************
'***********Utilizo la clase***************
Private Function Salvar(FormaG As Integer)
On Error GoTo Salvar_Error
Dim DatosE As clstblMedios
Set DatosE = New clstblMedios
With DatosE
If FormaG = 0 Then
.Id = .TomarFolio
.Medio = txtDescripcion.text
.Observacion = txtObservacion.text
.Estatus = chkEstatus.Value
.IdUsuarioReg = oPublica.idUsuario
.FechaReg = horaServer
myError = ""
If .Insert Then
.Incrementar
Else
GoTo Salvar_Error
End If
ElseIf FormaG = 1 Then
.Id = xClave
.Medio = txtDescripcion.text
.Observacion = txtObservacion.text
.Estatus = chkEstatus.Value
.IdUsuarioMod = oPublica.idUsuario
.FechaMod = horaServer
myError = ""
If Not .Update Then
GoTo Salvar_Error
End If
End If
End With
Call LoadInfo
Call Activa_Controles(False)
gTabla.SetFocus
lblMovimiento.Caption = ""
Salvar_Done:
frmAviso.lblTexto = "El registro ha sido almacenado exitosamente...!!!"
frmAviso.cmdCancelar.Visible = False
frmAviso.cmdAceptar.left = 1920
frmAviso.Show 1
Exit Function
Salvar_Error:
If Len(myError) > 0 Then
frmAviso.lblTexto = myError & "Error al tratar de Almacenar la Informacion...!!!"
frmAviso.cmdCancelar.Visible = False
frmAviso.cmdAceptar.left = 1920
frmAviso.Show 1
Else
Call SysException.Error(MODULE_NAME, "Salvar")
End If
End Function
'**************************************
Saludos desde Cancun mexico, suerte, portense mal y cuidense mucho  | 
Mode Lineal
