将记录存储在 class 的实例中并从 Sub 调用 class

Question

我有一个带有组合框的表单，我用来自访问数据库（用户界面与数据库分开的用户界面）的记录填充该组合框。我想做的是在程序的整个生命周期中将记录存储在 class 的实例中，而不是每次用户选择组合框时都查询 table 。代码在调用 Sub 中失败，可能是由于 class.

中的编码不正确

这是我连接到数据库的方式：

Option Explicit

Dim DBCONT As Object

Public Function connectDatabase()
    Set DBCONT = CreateObject("ADODB.Connection")
    Dim strDBPath As String
    strDBPath = "C:\Users\rob\Documents\Cyber Security\Database\BackEnd.accdb"
    Dim sConn As String
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                                "Data Source=" & strDBPath & ";" & _
                                "Jet OLEDB:Engine Type=5;" & _
                                "Persist Security Info=False;"
    DBCONT.Open sConn

    'Call closeDatabase
    End Function


Public Function closeDatabase()
    On Error Resume Next
    DBCONT.Close
    Set DBCONT = Nothing
    On Error GoTo 0

End Function

这是我尝试将记录存储为 CLASS 的一个实例。我在分配 "Set getdevices = Rs" 时收到错误消息类型不匹配，知道为什么吗？：

Option Explicit


Public Rs() As ADODB.Recordset


Function getdevices() As ADODB.Recordset

    connectDatabase

    Dim Rs As Object

    Dim CurDatabase As Object

    Set CurDatabase = CurrentDb

        Set RS = CurDatabase.OpenRecordset ("SELECT * FROM tblCDA")

    Set getdevices = Rs

    closeDatabase

    Set Rs = Nothing

End Function

调用 CLASS 的子程序：

Private Sub cboSysDesignation_Click()


Dim rsDevice As Object

Set rsDevice = getdevices(Rs)  'FAILS AT THIS POINT!!! "Object variable or With block variable not set"

DeviceName = cboSysDesignation.Value

rsDevice.MoveFirst

    Do Until DeviceName = rsDevice.Fields("DeviceID")
        rsDevice.MoveNext
    Loop

        txtSystemDescription.SetFocus
        If rsDevice!DESC <> "" Then
        txtSystemDescription.Value = rsDevice!DESC
        Else
        txtSystemDescription.Value = ""
        End If
        txtSystemEngineer.SetFocus
        If rsDevice!ENGINEER <> "" Then
        txtSystemEngineer.Value = rsDevice!ENGINEER
        Else
        txtSystemEngineer.Value = ""
        End If


Set rsDevice = Nothing

End Sub

Answer 1

您写道："I GET AN ERROR MESSAGE TYPE MISMATCH WHEN ASSIGNING "Set getdevices = Rs" 有什么想法吗？"

让我们单步执行您的代码...

Function getdevices() As ADODB.Recordset
    connectDatabase
    Dim Rs As Object
    Dim CurDatabase As Object
    Set CurDatabase = CurrentDb

CurrentDb 是一个 DAO.Database 对象。

    Set RS = CurDatabase.OpenRecordset ("SELECT * FROM tblCDA")

DAO.Database.OpenRecordset方法returns一个DAO记录集。

    Set getdevices = Rs

getdevices 被声明为 As ADODB.Recordset 但 Rs 是 DAO.Recordset。他们的类型不匹配。

将记录存储在 class 的实例中并从 Sub 调用 class

Store the records in an instance of a class and call the class from a Sub

ms-access

vba