ms 访问：遍历 DAO 记录集数组导致元素总是丢失

Question

我有一些“尝试”遍历 DAO 记录集数组的 vba 代码。运行循环时，我在

rst.MoveFirst

处收到运行时错误“需要对象”。似乎 rst 没有正确初始化，但我不确定如何修复它。也许以这种方式遍历记录集数组是不可能的，我以前从未尝试过。代码从自定义类模块运行。模块中有更多代码，但我在下面发布了大部分重要内容。我试过的几件事：

手动将 rst 设置为新的记录集实例：

Set rst = New DAO.Recordset

在循环外声明数组：

Set recordsets = Array(rstRechenwerte, rstZwischenwerte, rstZutaten)

' Loop through each recordset and insert data into Excel file
For Each rst In recordsets

在

rst.MoveFirst

之前首先设置为打开的记录集：

For Each rst In Array(rstRechenwerte, rstZwischenwerte, rstZutaten)
    Set rst = rst.OpenRecordset()
    rst.MoveFirst

数组中的三个recordset都正确初始化，set并且不是Nothing。我以前分别为三个记录集的每一个编写了代码，并且它是这样工作的。我知道我需要更改变量名称 XLColumn，但这并不是真正的问题 atm。它可能是一些基本的东西，但我暂时无法弄清楚所以我想我只是问一下。

我正在使用以下正确设置引用的库：

• Visual Basic 应用程序
• Microsoft Access 16.0 对象库
• OLE 自动化
• Microsoft Office 16.0 Access 数据库引擎 Object 图书馆
• Microsoft Excel 16.0 对象库
• Microsoft Office 16.0 对象库

我的Access版本：

Microsoft® Access® für Microsoft 365 MSO (Version 2301 Build 16.0.16026.20002) 32 Bit 

代码：

Option Compare Database
Option Explicit

Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim rsRes As DAO.Recordset     'rs of temp table (Output)
Dim rsZwi As DAO.Recordset     'rs of temp table (Zwischenwerte)
Dim rsRec As DAO.Recordset     'rs clone of subform Rechenwerte
Dim Recordset As Recordset
Dim rstRechenwerte As DAO.Recordset 'rs of tblRechenwerte
Dim rstZwischenwerte As DAO.Recordset   'rs of tblZwischenwerte
Dim rstZutaten As DAO.Recordset     'rs of tblZutaten
Dim RezeptID As Integer     'Current form active RezeptID
Dim RechengruppeID As Integer       'Current Form active RechengruppeID
Dim xlColumn As String  'Excel Column of Zutaten
Dim xlLastRow As Long   'Excel last row number after insertion
Dim xlColumn2 As String 'Excel Column one to the right of Zutaten
Dim k As Integer
Dim Export As Boolean   'Export the Excel File
Dim ExclExportPath As String    'Export location as string

Sub Calculate()
'***************************************************************************
'Purpose: Calculate a recipe based on Rechenwerte,
     'save them temporarily and display them on a form.
'Inputs: None
'***************************************************************************

'***********************************************************************
' Preparations
'***********************************************************************

'Disable user input
Call mdlMiscFunctions.DisableKeyboardMouse(True)

'Clear temporary data tables for Results and Zwischenwerte
If Not rsRes.EOF Then Call ClearTableOnClose("tblTempResults")
If Not rsZwi.EOF Then Call ClearTableOnClose("tblTempZwischenwerte")

'Prevent prompt to save changes to excel
xlApp.DisplayAlerts = False
xlApp.Visible = False

'***********************************************************************
' Insert Data into Excel File
'***********************************************************************


Dim rst As DAO.Recordset
Dim xlCell As String
Dim xlFormula As String
Dim xlColumn As String

' Loop through each recordset and insert data into Excel file
For Each rst In Array(rstRechenwerte, rstZwischenwerte, rstZutaten)
    rst.MoveFirst
    If Not rst.EOF Then
        Do Until rst.EOF
            xlCell = rst!xlCell
            xlSheet.Range(xlCell).Value = rst.Fields(1)
            If rst.Fields.Count > 2 Then
                xlFormula = rst!xlFormula
                xlSheet.Range(xlCell).Offset(0, 1).Formula = xlFormula
                xlSheet.Range(xlCell).Offset(0, 1).Value = xlSheet.Range(xlCell).Offset(0, 1).Value
            Else
                xlSheet.Range(xlCell).Offset(0, 1).Value = rst.Fields(2)
            End If
            rst.MoveNext
        Loop
    Else
        Select Case rst.Name
            Case "rstRechenwerte"
                MsgBox "Error: Keine Rechenwerte vorhanden!", vbCritical
            Case "rstZwischenwerte"
                MsgBox "Error: Keine Zwischenwerte vorhanden!", vbCritical
            Case "rstZutaten"
                MsgBox "Error: Keine Zutaten vorhanden!", vbCritical
        End Select
    End If
Next rst

类初始化如下：

Private Sub Class_Initialize()
'***************************************************************************
'Purpose: Sub for initializing class variables
'Inputs: None
'***************************************************************************

'Values for variables 1 (Neccesary for recordsets)
RezeptID = Forms.frmCalcBatch.RezeptID  'RezeptID on current form
RechengruppeID = Forms.frmCalcBatch.RechengruppeID  'Rechengruppe on Current Form
'Initialize Objects
Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Add
Set xlSheet = xlWB.Sheets("Tabelle1") 'Set xlSheet to the first sheet in the workbook
Set rsRes = CurrentDb.OpenRecordset("tblTempResults", dbOpenDynaset)
Set rsZwi = CurrentDb.OpenRecordset("tblTempZwischenwerte", dbOpenDynaset)
Set rsRec = Forms.frmCalcBatch.frmSubRechenwerteBox.Form.Recordset.Clone    'rs clone of Rechenwerte subform
Set rstRechenwerte = CurrentDb.OpenRecordset("SELECT Rechenwert, WertBezeichnung, XLCell FROM tblRechenwerte WHERE RechengruppeID = " & RechengruppeID)
Set rstZwischenwerte = CurrentDb.OpenRecordset("SELECT ZWBezeichnung, XLFormula, XLCell FROM tblZwischenwerte WHERE RezeptID = " & RezeptID)
Set rstZutaten = CurrentDb.OpenRecordset("SELECT Zutat, XLFormula, XLCell FROM tblZutaten WHERE RezeptID = " & RezeptID)
'Values for Variables 2 (recordsets neccesary for variables)
xlColumn2 = Split(rstZutaten!xlCell, "1")(0)    'extract excel column denominator for Zutaten
xlColumn2 = Chr(Asc(xlColumn2) + 1)     'Move one column to the right using Asc (A->B etc.)

'Settings:
If Forms.frmCalcBatch.cbExport = True Then
    Export = True
    ExclExportPath = GetExportPath
Else
    Export = False
    ExclExportPath = ""
End If

End Sub

Answer 1

你不能

New

DAO.Recordset

，代码甚至不会编译。

要遍历记录集数组，每个记录集必须在添加到数组之前进行初始化。

例如：

Dim r1 As DAO.Recordset, r2 As DAO.Recordset, r3 As DAO.Recordset

Set r1 = CurrentDb().OpenRecordset("YourTableOrQueryName")
Set r2 = CurrentDb().OpenRecordset("YourTableOrQueryName")
Set r3 = CurrentDb().OpenRecordset("YourTableOrQueryName")

现在将记录集放入数组中。

Dim arr As Variant
arr = Array(r1, r2, r3)

要循环，您需要使用

For

循环并直接从数组访问记录集，或者声明另一个记录集变量来保存迭代记录集。

通过迭代器变量：

Dim r As DAO.Recordset, i As Integer

For i = LBound(arr) To UBound(arr)
    Set r = arr(i)
    If Not r.EOF Then
        r.MoveFirst
        Debug.Print r.RecordCount
    End If
Next i

直接从数组访问它：

For i = LBound(arr) To UBound(arr)
    If Not arr(i).EOF Then
        arr(i).MoveFirst
        Debug.Print arr(i).RecordCount
    End If
Next i

虽然我不明白为什么你需要同时在内存中有 3 个记录集。就个人而言，我会将需要在循环中完成的工作卸载到一个单独的函数并将记录集作为参数传递。该函数本身会返回成功/失败状态，因此您可以根据结果采取适当的措施。

另一种方法是将源名称存储在数组中，并在循环期间按需创建记录集。

希望这有帮助。