Tập bản ghi MS-Access và Mô-đun lớp

Giới thiệu.

Tại đây, chúng tôi sẽ xây dựng Mô-đun lớp cho các tác vụ xử lý dữ liệu, một DAO.Recordset Đối tượng sẽ được chuyển cho Đối tượng lớp tùy chỉnh. Vì nó là một Đối tượng được chuyển đến Lớp tùy chỉnh của chúng tôi, nên chúng tôi cần Bộ và Nhận Cặp thủ tục thuộc tính để gán và truy xuất đối tượng hoặc các giá trị thuộc tính của nó.

Chúng tôi có một Bảng nhỏ: Table1 , với ít hồ sơ trong đó. Đây là hình ảnh của Table1.

Bảng trên chỉ có bốn trường:Desc, Qty, UnitPrice và TotalPrice. Trường TotalPrice trống.

• Một trong những nhiệm vụ của Mô-đun lớp của chúng tôi là Cập nhật trường TotalPrice bằng sản phẩm Qty * UnitPrice.
• Mô-đun lớp có một chương trình con để sắp xếp dữ liệu, trên trường do người dùng chỉ định và kết xuất danh sách trên Cửa sổ gỡ lỗi.
• Một chương trình con khác tạo một bản sao của Bảng với tên mới, sau khi sắp xếp dữ liệu dựa trên số cột được cung cấp dưới dạng tham số.

Mô-đun lớp ClsRecUpdate.

1. Mở Cơ sở dữ liệu Access của bạn và mở Cửa sổ VBA.
2. Chèn Mô-đun lớp học.
3. Thay đổi Giá trị Thuộc tính Tên của nó thành ClsRecUpdate .
4. Sao chép và Dán mã sau vào Mô-đun lớp và lưu Mô-đun:
   

   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
   
   

Thuộc tính rstB được khai báo là Đối tượng DAO.Recordset.

Thông qua Thủ tục thuộc tính đặt, một đối tượng tập bản ghi có thể được chuyển đến Lớp ClsRecUpdate Đối tượng.

Cập nhật () Chương trình con chấp nhận số ba cột (số cột dựa trên 0) làm tham số để tính toán và cập nhật cột tham số thứ ba với tích của cột đầu tiên * cột thứ hai.

DataSort () chương trình con Sắp xếp các bản ghi theo thứ tự tăng dần dựa trên Số cột được truyền dưới dạng tham số.

Kiểu dữ liệu Cột Sắp xếp phải là Số hoặc Tiền tệ hoặc Chuỗi. Các kiểu dữ liệu khác bị bỏ qua.

Danh sách các bản ghi sẽ được kết xuất trên Cửa sổ gỡ lỗi. Danh sách các trường sẽ chỉ được giới hạn trong năm trường, nếu nguồn bản ghi có nhiều hơn số đó thì phần còn lại của các trường sẽ bị bỏ qua.

TblCreate () chương trình con sẽ Sắp xếp dữ liệu, dựa trên số cột được truyền dưới dạng tham số và tạo Bảng với tên mới. Tham số là tùy chọn, nếu một số cột không được truyền dưới dạng tham số thì Bảng sẽ được sắp xếp trên dữ liệu trong cột đầu tiên nếu kiểu dữ liệu của cột là kiểu hợp lệ. Tên ban đầu của Bảng sẽ được sửa đổi và thêm vào Chuỗi “_2” sang tên ban đầu. Nếu tên Bảng nguồn là Table1 thì tên bảng mới sẽ là Table1_2 .

Chương trình Thử nghiệm cho ClsUpdate.

Hãy để chúng tôi kiểm tra ClsRecUpdate Đối tượng lớp với một chương trình nhỏ.

Mã chương trình thử nghiệm được cung cấp dưới đây:

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

Bạn có thể vượt qua bất kỳ tập hợp bản ghi nào để kiểm tra Đối tượng Lớp.

Bạn có thể chuyển bất kỳ số cột nào để cập nhật một cột cụ thể. Các số cột không nhất thiết phải là các số liên tiếp. Tuy nhiên, tham số số cột thứ ba là cột mục tiêu cần cập nhật. Tham số đầu tiên được nhân với tham số cột thứ hai để đến giá trị kết quả cần cập nhật. Bạn có thể sửa đổi mã Mô-đun lớp để thực hiện bất kỳ thao tác nào khác mà bạn muốn thực hiện trên bảng.

Lựa chọn kiểu dữ liệu Cột Sắp xếp chỉ được là Chuỗi, Số hoặc Loại tiền tệ. Các loại khác bị bỏ qua. Số cột của bộ bản ghi dựa trên 0, có nghĩa là số cột đầu tiên là 0, cột thứ hai là 1, v.v.

Danh sách Tất cả các Liên kết về Chủ đề này.

1. Mô-đun lớp MS-Access và VBA
2. Mảng đối tượng lớp VBA MS-Access
3. Lớp cơ sở MS-Access và các đối tượng có nguồn gốc
4. Lớp cơ sở VBA và các đối tượng có nguồn gốc-2
5. Lớp cơ sở và các biến thể đối tượng có nguồn gốc
6. Tập bản ghi Ms-Access và Mô-đun lớp
7. Truy cập mô-đun lớp và các lớp gói
8. Chuyển đổi chức năng lớp bao bọc
9. Thông tin cơ bản về Ms-Access và Đối tượng Bộ sưu tập
10. Mô-đun lớp Ms-Access và Đối tượng Bộ sưu tập
11. Bản ghi Bảng trong Đối tượng và Biểu mẫu Bộ sưu tập
12. Khái niệm cơ bản về đối tượng từ điển
13. Khái niệm cơ bản về đối tượng từ điển-2
14. Sắp xếp các mục và khóa đối tượng từ điển
15. Hiển thị Bản ghi từ Từ điển sang Biểu mẫu
16. Thêm các đối tượng lớp dưới dạng các mục từ điển
17. Cập nhật Mục Từ điển Đối tượng Lớp trên Biểu mẫu