MS-Access Recordset и Class Module

Въведение.

Тук ще изградим модул за клас за задачи по обработка на данни, DAO.Recordset Обектът ще бъде предаден на Custom Class Object. Тъй като това е обект, който преминава към нашия персонализиран клас, ние се нуждаем от Set иВземете Свойство Процедура двойка за присвояване и извличане на Обекта или неговите стойности на свойства.

Имаме малка таблица:Таблица1 , с малко записи в него. Ето изображението на Таблица 1.

Таблицата по-горе има само четири полета:Desc, Qty, UnitPrice и TotalPrice. Полето TotalPrice е празно.

Една от задачите на нашия модул Class е да актуализира полето TotalPrice с произведението на Qty * UnitPrice.
Модулът Class има подпрограма за сортиране на данните в зададеното от потребителя поле и изхвърля списък в прозореца за отстраняване на грешки.
Друга подпрограма създава копие на таблицата с ново име, след като сортира данните въз основа на номера на колоната, предоставен като параметър.

ClsRecUpdate Class Module.

Отворете вашата база данни на Access и отворете прозореца VBA.
Вмъкнете модул за клас.
Променете стойността на свойството на името на ClsRecUpdate .

Копирайте и поставете следния код в модула Class и запазете модула:

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

Свойството rstB е декларирано като обект DAO.Recordset.

Чрез процедурата за свойство Set, обект на набор от записи може да бъде предаден на класа ClsRecUpdate Обект.

Update() Подпрограмата приема числа от три колони (номера на колони, базирани на 0) като параметри за изчисляване и актуализиране на третата колона с параметър с произведението на първата колона * втората колона.

DataSort() подпрограма Сортира записите във възходящ ред въз основа на номера на колоната, предадена като параметър.

Типът данни на колоната за сортиране трябва да бъде число, валута или низ. Други типове данни се игнорират.

Списък на записите ще бъде изхвърлен в прозореца за отстраняване на грешки. Списъкът с полета ще бъде ограничен само до пет полета, ако източникът на запис има повече от това, тогава останалите полета се игнорират.

TblCreate() подпрограмата ще сортира данните въз основа на номера на колоната, подадена като параметър, и ще създаде таблица с ново име. Параметърът е незадължителен, ако номер на колона не е подадена като параметър, тогава таблицата ще бъде сортирана по данни в първата колона, ако типът данни на колоната е валиден тип. Оригиналното име на таблицата ще бъде променено и добавено с низ “_2” към оригиналното име. Ако името на таблицата на източника е Таблица1 тогава името на новата таблица ще бъде Таблица1_2 .

Тестовата програма за ClsUpdate.

Нека тестваме ClsRecUpdate Обект на клас с малка програма.

Кодът на тестовата програма е даден по-долу:

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

Можете да подадете произволен набор от записи, за да тествате Class Object.

Можете да подадете всякакви номера на колони за актуализиране на конкретна колона. Номерата на колоните не са непременно последователни числа. Но параметърът за номер на третата колона е целевата колона за актуализиране. Първият параметър се умножава по параметъра на втората колона, за да се стигне до стойността на резултата за актуализиране. Можете да промените кода на модула на класа, за да извършите всяка друга операция, която искате да направите на масата.

Изборът на тип данни за колона за сортиране трябва да бъде само низ, число или тип валута. Други типове се игнорират. Номерата на колоните на набора от записи са базирани на 0, което означава, че номерът на първата колона е 0, втората колона е 1 и т.н.

Списък с всички връзки по тази тема.

Модул за MS-Access Class и VBA
Обектни масиви от клас VBA на MS-Access
Основен клас на MS-Access и производни обекти
Базов клас на VBA и производни обекти-2
Варианти на основен клас и производен обект
Ms-Access Recordset and Class Module
Достъп до модул за класове и класове за обвивка
Преобразуване на функционалност на класа на обвивката
Основи на Ms-Access и колекция обекти
Модул за клас Ms-Access и обект на колекция
Записи в таблицата в обект и форма на колекция
Основи на обекта на речника
Основи на обекта на речника-2
Сортиране на ключове и елементи в речника
Показване на записи от речник към формуляр
Добавяне на обекти на клас като елементи от речника
Актуализиране на елемент от речника за обект на клас във формуляра