Conjunto de registros e módulo de classe do MS-Access

Introdução.

Aqui, construiremos um módulo de classe para tarefas de processamento de dados, um DAO.Recordset O objeto será passado para o objeto de classe personalizada. Como é um objeto que está passando para nossa classe personalizada, precisamos do conjunto e obtenha Par de procedimentos de propriedade para atribuir e recuperar o objeto ou seus valores de propriedade.

Temos uma pequena tabela:Tabela1 , com poucos registros. Aqui está a imagem da Tabela1.

A tabela acima tem apenas quatro campos:Desc, Qty, UnitPrice e TotalPrice. O campo TotalPrice está vazio.

Uma das tarefas do nosso módulo de classe é atualizar o campo TotalPrice com o produto Qty * UnitPrice.
O módulo de classe tem uma sub-rotina para classificar os dados, no campo especificado pelo usuário, e despeja uma listagem na janela de depuração.
Outra sub-rotina cria uma cópia da Tabela com um novo nome, após ordenar os dados com base no número da coluna fornecido como parâmetro.

Módulo de classe ClsRecUpdate.

Abra seu banco de dados do Access e abra a janela VBA.
Insira um módulo de classe.
Altere o valor da propriedade do nome para ClsRecUpdate .

Copie e cole o seguinte código no módulo de classe e salve o 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

A propriedade rstB é declarada como um objeto DAO.Recordset.

Por meio do procedimento de propriedade de conjunto, um objeto de conjunto de registros pode ser passado para a classe ClsRecUpdate Objeto.

A Atualização() A subrotina aceita números de três colunas (números de coluna baseados em 0) como parâmetros para calcular e atualizar a terceira coluna de parâmetro com o produto da primeira coluna * segunda coluna.

O DataSort() sub-rotina Classifica os registros em ordem crescente com base no Número da Coluna passado como parâmetro.

O tipo de dados da Coluna de Classificação deve ser Número ou Moeda ou String. Outros tipos de dados são ignorados.

Uma lista dos registros será despejada na janela de depuração. A listagem de campos será limitada a apenas cinco campos, se a fonte de registro tiver mais do que isso, o restante dos campos será ignorado.

O TblCreate() A sub-rotina classificará os dados, com base no número da coluna passado como parâmetro, e criará uma Tabela com um novo nome. O parâmetro é opcional, se um número de coluna não for passado como parâmetro, a Tabela será classificada nos dados da primeira coluna se o tipo de dados da coluna for um tipo válido. O nome original da Tabela será modificado e adicionado com a String “_2” ao nome original. Se o nome da tabela de origem for Tabela1 então o novo nome da tabela será Tabela1_2 .

O Programa de Teste para ClsUpdate.

Vamos testar o ClsRecUpdate Objeto de classe com um pequeno programa.

O código do programa de teste é dado abaixo:

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

Você pode passar qualquer conjunto de registros para testar o objeto de classe.

Você pode passar qualquer número de coluna para atualizar uma coluna específica. Os números das colunas não são necessariamente números consecutivos. Mas, o terceiro parâmetro do número da coluna é a coluna de destino a ser atualizada. O primeiro parâmetro é multiplicado pelo segundo parâmetro de coluna para chegar ao valor do resultado a ser atualizado. Você pode modificar o código do Módulo de Classe para fazer qualquer outra operação que deseje fazer na mesa.

A seleção do tipo de dados da Coluna de classificação deve ser apenas String, Numeric ou Currency Type. Outros tipos são ignorados. Os números de coluna do conjunto de registros são baseados em 0, o que significa que o número da primeira coluna é 0, a segunda coluna é 1 e assim por diante.

Lista de todos os links neste tópico.

Módulo de classe MS-Access e VBA
Matrizes de objetos de classe VBA do MS-Access
Classe base do MS-Access e objetos derivados
Classe básica do VBA e objetos derivados-2
Classe base e variantes de objetos derivados
Ms-Access Recordset and Class Module
Módulo de classe de acesso e classes wrapper
Transformação da funcionalidade da classe wrapper
Noções básicas de Ms-Access e objetos de coleção
Módulo de classe Ms-Access e objeto de coleção
Registros de tabela no objeto e formulário de coleção
Noções básicas de objetos do dicionário
Noções básicas de objetos do dicionário-2
Classificação de chaves e itens de objetos de dicionário
Exibir registros do dicionário para o formulário
Adicionar objetos de classe como itens de dicionário
Atualizar item do dicionário de objetos de classe no formulário