sql >> Base de Datos >  >> RDS >> Access

Conjunto de registros y módulo de clase de MS-Access

Introducción.

Aquí, construiremos un módulo de clase para tareas de procesamiento de datos, un DAO.Recordset El objeto se pasará al objeto de clase personalizado. Dado que es un Objeto que está pasando a nuestra Clase Personalizada, necesitamos el Conjunto y Obtener Par de procedimientos de propiedad para asignar y recuperar el objeto o sus valores de propiedad.

Tenemos una pequeña Mesa:Mesa1 , con pocos registros en el mismo. Aquí está la imagen de Table1.

La tabla anterior tiene solo cuatro campos:Desc, Qty, UnitPrice y TotalPrice. El campo PrecioTotal está vacío.

  • Una de las tareas de nuestro Módulo de Clase es Actualizar el campo PrecioTotal con el producto de Ctd. * PrecioUnidad.
  • El módulo de clase tiene una subrutina para ordenar los datos, en el campo especificado por el usuario, y arroja una lista en la ventana de depuración.
  • Otra subrutina crea una copia de la Tabla con un nuevo nombre, después de ordenar los datos según el número de columna proporcionado como parámetro.

Módulo Clase ClsRecUpdate.

  1. Abra su base de datos de Access y abra la ventana de VBA.
  2. Inserte un módulo de clase.
  3. Cambiar su valor de propiedad de nombre a ClsRecUpdate .
  4. Copie y pegue el siguiente código en el módulo de clase y guarde el módulo:
    Option Compare Database
Option Explicit

Private rstB As DAO.Recordset

Public Property Get REC() As DAO.Recordset
   Set REC = rstB
End Property

Public Property Set REC(ByRef oNewValue As DAO.Recordset)
If Not oNewValue Is Nothing Then
   Set rstB = oNewValue
End If
End Property

Public Sub Update(ByVal Source1Col As Integer, ByVal Source2Col As Integer, ByVal updtcol As Integer)
'Updates a Column with the product of two other columns
Dim col As Integer

col = rstB.Fields.Count

'Validate Column Parameters
If Source1Col > col Or Source2Col > col Or updtcol > col Then
    MsgBox "One or more Column Number(s) out of bound!", vbExclamation, "Update()"
    Exit Sub
End If

'Update Field
On Error GoTo Update_Err
rstB.MoveFirst
Do While Not rstB.EOF
   rstB.Edit
     With rstB
      .Fields(updtcol).Value = .Fields(Source1Col).Value * .Fields(Source2Col).Value
      .Update
      .MoveNext
     End With
Loop

Update_Exit:
rstB.MoveFirst
Exit Sub

Update_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "Update()"
Resume Update_Exit
End Sub

Public Sub DataSort(ByVal intCol As Integer)
Dim cols As Long, colType
Dim colnames() As String
Dim k As Long, colmLimit As Integer
Dim strTable As String, strSortCol As String
Dim strSQL As String
Dim db As Database, rst2 As DAO.Recordset

On Error GoTo DataSort_Err

cols = rstB.Fields.Count - 1
strTable = rstB.Name
strSortCol = rstB.Fields(intCol).Name

'Validate Sort Column Data Type
colType = rstB.Fields(intCol).Type
Select Case colType
    Case 3 To 7, 10
        strSQL = "SELECT " & strTable & ".* FROM " & strTable & " ORDER BY " & strTable & ".[" & strSortCol & "];"
        Debug.Print "Sorted on " & rstB.Fields(intCol).Name & " Ascending Order"

    Case Else
        strSQL = "SELECT " & strTable & ".* FROM " & strTable & ";"

        Debug.Print "// SORT: COLUMN: <<" & strSortCol & " Data Type Invalid>> Valid Type: String,Number & Currency //"
        Debug.Print "Data Output in Unsorted Order"
End Select

Set db = CurrentDb
Set rst2 = db.OpenRecordset(strSQL)

ReDim colnames(0 To cols) As String

'Save Field Names in Array to Print Heading
For k = 0 To cols
   colnames(k) = rst2.Fields(k).Name
Next

'Print Section
Debug.Print String(52, "-")

'Print Column Names as heading
If cols > 4 Then
   colmLimit = 4
Else
   colmLimit = cols
End If
For k = 0 To colmLimit
    Debug.Print colnames(k),
Next: Debug.Print
Debug.Print String(52, "-")

'Print records in Debug window
rst2.MoveFirst
Do While Not rst2.EOF
  For k = 0 To colmLimit 'Listing limited to 5 columns only
     Debug.Print rst2.Fields(k),
  Next k: Debug.Print
rst2.MoveNext
Loop

rst2.Close
Set rst2 = Nothing
Set db = Nothing

DataSort_Exit:
Exit Sub

DataSort_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "DataSort()"
Resume DataSort_Exit

End Sub

Public Sub TblCreate(Optional SortCol As Integer = 0)
Dim dba As DAO.Database, tmp() As Variant
Dim tbldef As DAO.TableDef
Dim fld As DAO.Field, idx As DAO.Index
Dim rst2 As DAO.Recordset, i As Integer, fldcount As Integer
Dim strTable As String, rows As Long, cols As Long

On Error Resume Next

strTable = rstB.Name & "_2"
Set dba = CurrentDb

On Error Resume Next
TryAgain:
Set rst2 = dba.OpenRecordset(strTable)
If Err > 0 Then
  Set tbldef = dba.CreateTableDef(strTable)
  Resume Continue
Else
  rst2.Close
  dba.TableDefs.Delete strTable
  dba.TableDefs.Refresh
  GoTo TryAgain
End If
Continue:
On Error GoTo TblCreate_Err

fldcount = rstB.Fields.Count - 1
ReDim tmp(0 To fldcount, 0 To 1) As Variant

'Save Source File Field Names and Data Type
For i = 0 To fldcount
    tmp(i, 0) = rstB.Fields(i).Name: tmp(i, 1) = rstB.Fields(i).Type
Next
'Create Fields and Index for new table
For i = 0 To fldcount
   tbldef.Fields.Append tbldef.CreateField(tmp(i, 0), tmp(i, 1))
Next
'Create index to sort data
Set idx = tbldef.CreateIndex("NewIndex")
With idx
   .Fields.Append .CreateField(tmp(SortCol, 0))
End With
'Add Tabledef and index to database
tbldef.Indexes.Append idx
dba.TableDefs.Append tbldef
dba.TableDefs.Refresh

'Add records to the new table
Set rst2 = dba.OpenRecordset(strTable, dbOpenTable)
rstB.MoveFirst 'reset to the first record
Do While Not rstB.EOF
   rst2.AddNew 'create record in new table
    For i = 0 To fldcount
        rst2.Fields(i).Value = rstB.Fields(i).Value
    Next
   rst2.Update
rstB.MoveNext 'move to next record
Loop
rstB.MoveFirst 'reset record pointer to the first record
rst2.Close

Set rst2 = Nothing
Set tbldef = Nothing
Set dba = Nothing

MsgBox "Sorted Data Saved in " & strTable

TblCreate_Exit:
Exit Sub

TblCreate_Err:
MsgBox Err & " : " & Err.Description, vbExclamation, "TblCreate()"
Resume TblCreate_Exit

End Sub

La propiedad rstB se declara como un objeto DAO.Recordset.

A través del procedimiento Establecer propiedad, se puede pasar un objeto de conjunto de registros a la Clase ClsRecUpdate Objeto.

La Actualización() La subrutina acepta números de tres columnas (números de columna basados ​​en 0) como parámetros para calcular y actualizar la columna del tercer parámetro con el producto de la primera columna * la segunda columna.

El clasificación de datos() subrutina Ordena los registros en orden ascendente según el Número de columna pasado como parámetro.

El tipo de datos de la columna de clasificación debe ser Número, Moneda o Cadena. Se ignoran otros tipos de datos.

Se volcará una lista de los registros en la ventana de depuración. La lista de campos se limitará a solo cinco campos, si la fuente de registro tiene más que eso, el resto de los campos se ignoran.

El TblCreate() La subrutina ordenará los datos, según el número de columna pasado como parámetro, y creará una tabla con un nuevo nombre. El parámetro es opcional, si no se pasa un número de columna como parámetro, la tabla se ordenará según los datos de la primera columna si el tipo de datos de la columna es un tipo válido. El nombre original de la Tabla será modificado y agregado con la Cadena “_2” al nombre original. Si el nombre de la tabla de origen es Table1 entonces el nuevo nombre de la tabla será Table1_2 .

El programa de prueba para ClsUpdate.

Probemos el ClsRecUpdate Objeto de Clase con un Programa pequeño.

El código del programa de prueba se proporciona a continuación:

Public Sub DataProcess()
Dim db As DAO.Database
Dim rstA As DAO.Recordset

Dim R_Set As ClsRecUpdate
Set R_Set = New ClsRecUpdate

Set db = CurrentDb
Set rstA = db.OpenRecordset("Table1", dbOpenTable)

'send Recordset Object to Class Object
Set R_Set.REC = rstA

'Update Total Price Field
Call R_Set.Update(1, 2, 3) 'col3=col1 * col2

'Sort Ascending Order on UnitPrice column & Print in Debug Window
Call R_Set.DataSort(2)

'Create New Table Sorted on UnitPrice in Ascending Order
Call R_Set.TblCreate(2) 
Set rstA = Nothing
Set db = Nothing
xyz:
End Sub

Puede pasar cualquier conjunto de registros para probar el objeto de clase.

Puede pasar cualquier número de columna para actualizar una columna en particular. Los números de columna no necesariamente deben ser números consecutivos. Pero, el tercer parámetro de número de columna es la columna de destino para actualizar. El primer parámetro se multiplica por el parámetro de la segunda columna para llegar al valor del resultado a actualizar. Puede modificar el código del Módulo de clase para realizar cualquier otra operación que desee en la mesa.

La selección del tipo de datos de Ordenar columna debe ser Cadena, Numérico o Tipo de moneda únicamente. Se ignoran otros tipos. Los números de columna del conjunto de registros se basan en 0, lo que significa que el número de la primera columna es 0, el de la segunda columna es 1, y así sucesivamente.

Lista de todos los enlaces sobre este tema.

  1. Módulo de clase MS-Access y VBA
  2. Matrices de objetos de clase VBA de MS-Access
  3. Clase base de MS-Access y objetos derivados
  4. Clase base de VBA y objetos derivados-2
  5. Variantes de clase base y objeto derivado
  6. Conjunto de registros y módulo de clase Ms-Access
  7. Módulo de clase de acceso y clases contenedoras
  8. Transformación de la funcionalidad de la clase contenedora
  9. Conceptos básicos de Ms-Access y objetos de colección
  10. Módulo de clase Ms-Access y objeto de colección
  11. Registros de tabla en objeto y formulario de colección
  12. Conceptos básicos de objetos de diccionario
  13. Conceptos básicos de objetos de diccionario-2
  14. Ordenar elementos y claves de objetos del diccionario
  15. Mostrar registros del diccionario al formulario
  16. Agregar objetos de clase como elementos de diccionario
  17. Actualizar elemento del diccionario de objetos de clase en el formulario