Question

我遇到了以下问题我无法通过。我试图在循环中创建记录集。想法是向用户表单中添加与用户选择的日期范围相关的一些条目。当用户只选择一个日期代码时工作正常，但是当用户选择日期范围时，它会在第二个循环传递时失败，上面的运行时错误 - 无效对象或没有值。这是我的代码（其中一部分实际上有点简化以显示问题）：

Dim sql, sql2 As String
Dim x, daty As Integer

Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset

For x = 0 To 3   '''replaced user selected date ranges with 3 to simplify code
     sql = "INSERT INTO tDzialaniaRejestracja (IdSzkolenia, TerminRozpoczecia) VALUES (" & Me.IdSzkolenia & ", '" & Format((Me.DataRozpoczecia + x), "dd.mm.yyyy")  & "')"
     With dbs
        Set qdf = dbs.CreateQueryDef("", sql)    '''here i get runtine error 3420 on second loop pass
        qdf.Execute dbFailOnError
        sql2 = "SELECT @@IDENTITY"
        Set rs = .OpenRecordset(sql2, dbOpenDynaset)
        lastID = rs.Fields(0)
        rs.Close
        dbs.Close
     End With

     Me.IdDzialania = lastID
     Me.ProwadzacyFirmaZewn.Value = 23

     Set qdf = Nothing
     Set rs = Nothing

Next x

任何提示都非常感谢。非常感谢你提前。

问候

Answer 1

我尝试了这个小块，它也在第二个循环上给了我3420。

Sub TestMe()
    Dim dbs As DAO.Database
    Dim qdf As DAO.QueryDef

    Set dbs = CurrentDb
    Dim x As Long

    For x = 0 To 3
        Set qdf = dbs.CreateQueryDef("", "SELECT * FROM TABELLE1")
        dbs.Close
    Next x

End Sub

因此，问题是您在第一次迭代中关闭了dbs，然后您正在引用它。

Answer 2

不要为每个循环迭代创建新查询。只需使用一个查询，并使用参数插入不同的数据。

正如Vityata指出的那样，真正的问题是你在第一次迭代时关闭了dbs。我已经解决了这个问题。但我无法优化此代码...

Dim sql, sql2 As String
Dim x, daty As Integer

Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
sql = "INSERT INTO tDzialaniaRejestracja (IdSzkolenia, TerminRozpoczecia) VALUES (@Param1, @Param2)"
Set qdf = dbs.CreateQueryDef("", sql)  
For x = 0 To 3   
     qdf.Parameters("@Param1") = Me.IdSzkolenia
     qdf.Parameters("@Param2") = Format((Me.DataRozpoczecia + x), "dd.mm.yyyy")
     With dbs
        qdf.Execute dbFailOnError
        sql2 = "SELECT @@IDENTITY"
        Set rs = .OpenRecordset(sql2, dbOpenDynaset)
        lastID = rs.Fields(0)
        rs.Close
     End With

     Me.IdDzialania = lastID
     Me.ProwadzacyFirmaZewn.Value = 23
     Set rs = Nothing
Next x
'Not necessary, no benefit whatsoever in the following code, but it goes here if you want it
dbs.Close
Set dbs = Nothing
Set qdf = Nothing

这有许多额外的优点，例如允许Access只编译一次查询，简化代码，避免可能的SQL注入等。

访问vba - 在循环中使用记录集时获取运行时错误3420（无效对象）

2 个答案: