VBA：错误 3265 - "Item not found in this collection"

Question

在 Access 2016 中，我试图打开一个 recordset 并将其中的数据保存在其他变量中，但我一直收到此错误。该程序本身有更多部分，但我只在这一个中出错，它只是更新其 database.

上的数据

这是我的代码：

Option Compare Database
Option Explicit


Private Sub btnValidateTimesheet_Click()

    ' Update timesheet to "Justificat"

    Dim intIdTimesheet As Integer

    If IsNull(cmbDraftTimesheets.Value) Then
        MsgBox("You have to select a timesheet that is Borrador")
        Exit Sub
    End If

    intIdTimesheet = cmbDraftTimesheets.Column(0)

    DoCmd.SetWarnings False
    DoCmd.RunSQL "update Timesheets set estat = ""Justificat"" where id=" & intIdTimesheet
    DoCmd.SetWarnings True

End Sub


Private Sub btnValidateTimesheetLines_Click()

    ' We select the timesheet_lines for employee, project, activity and dates selected
    ' For each justification, a new "Justificat" Timesheet is generated which hang timesheet_lines


    ' ------------------------------- Variables -------------------------------
    Dim dictTsLines As Object
    Set dictTsLines = CreateObject("Scripting.Dictionary")

    ' Form inputs
    Dim intCodTreb As Integer
    Dim strCodProj As String
    Dim dateInici, dateFi As Date
    Dim intExercici As Integer

    ' Query strings
    Dim strSQLFrom, strSQLWhere As String
    Dim strSQLCount, strSQLJustAct, strSQLTsLines As String

    ' Recordsets
    Dim rsCount, rsJustAct, rsTimesheets, rsTsLines As Recordset

    ' Aux and others...
    Dim continue As Integer
    Dim intIdJustificacio, intIdTs As Integer
    Dim strActivitat As String

    ' --------------------------------------- Main ---------------------------------------------
    ' Taking form data
    intCodTreb = cmbTreballador.Column(0)
    strCodProj = cmbProjecte.Column(1)
    dateInici = txtDataInici.Value
    dateFi = txtDataFi.Value

    ' We check the dates are correct
    If IsNull(dateInici) Or IsNull(dateFi) Then
        MsgBox("Dates can't be null")
        Exit Sub
    End If

    If dateFi < dateInici Then
        MsgBox("Start date must be earlier or the same as final date")
        Exit Sub
    End If

    If year(dateInici) <> year(dateFi) Then
        MsgBox("Dates must be in the same year")
        Exit Sub
    End If

    intExercici = year(dateInici)

    ' Make of the clause FROM and WHERE of the select query of timesheet_lines
    strSQLFrom = " from (timesheet_lines tsl " & _
        " left join timesheets ts on tsl.timesheet_id = ts.id) " & _
        " left join justificacions j on j.id = ts.id_justificacio "

    strSQLWhere = " where ts.estat = ""Borrador"" " & _
        " and tsl.data >= #" & Format(dateInici, "yyyy/mm/dd") & "# " & _
        " and tsl.data <= #" & Format(dateFi, "yyyy/mm/dd") & "# "

    If Not IsNull(intCodTreb) Then
        strSQLWhere = strSQLWhere & " and tsl.cod_treb = " & intCodTreb
    End If

    If Not IsNull(strCodProj) Then
        strSQLWhere = strSQLWhere & " and j.cod_proj=""" & strCodProj & """ "
    End If

    ' Alert how much timesheet_lines are going to be validated
    strSQLCount = "select count(*) " & strSQLFrom & strSQLWhere
    Set rsCount = CurrentDb.OpenRecordset(strSQLCount)
    Continue Do = MsgBox( rsCount(0) & " registries are going to be validated" & vbNewLine & _
        "Do you want to continue?", vbOKCancel)

    If continue <> 1 Then
        Exit Sub
    End If

    ' We select the tuples Justificacio, Activitat of timesheet_lines selected
    strSQLJustAct = "select distinct ts.id_justificacio " & strSQLFrom & strSQLWhere
    Set rsJustAct = CurrentDb.OpenRecordset(strSQLJustAct)
    Set rsTimesheets = CurrentDb.OpenRecordset("Timesheets")

    ' A new timesheet is generated for each tupla
    Do While Not rsJustAct.EOF
        intIdJustificacio = rsJustAct(0)
        strActivitat = rsJustAct(1)

        rsTimesheets.AddNew
        rsTimesheets!data_generacio = Now()
        rsTimesheets!estat = "Justificat"
        rsTimesheets!Id_justificacio = intIdJustificacio
        rsTimesheets!activitat = strActivitat
        rsTimesheets!data_inici = dateInici
        rsTimesheets!data_fi = dateFi
        rsTimesheets!exercici = intExercici
        intIdTs = rsTimesheets!Id
        rsTimesheets.Update

        ' We save the related id of the selected timesheet in a dictionary
        dictTsLines.Add intIdJustificacio & "_" & strActivitat, intIdTs

        rsJustAct.MoveNext
    Loop

    ' We select all the affected timesheet_lines and we update the related timesheet using the dictionary
    strSQLTsLines = "select tsl.id, tsl.timesheet_id, ts.id_justificacio, ts.activitat " & strSQLFrom & strSQLWhere
    Set rsTsLines = CurrentDb.OpenRecordset(strSQLTsLines)
    With rsTsLines
        Do While Not .EOF
            .EDIT
            intIdJustificacio = !Id_justificacio
            strActivitat = !activitat
            !timesheet_id = dictTsLines.Item(intIdJustificacio & "_" & strActivitat)
            .Update
            .MoveNext
        Loop
    End With

    rsTimesheets.Close
    Set rsCount = Nothing
    Set rsJustAct = Nothing
    Set rsTimesheets = Nothing
    Set rsTsLines = Nothing

End Sub

调试器：错误出现在行：

strActivitat = rsJustAct(1)

我检查过 recordset 正在保存的数据确实存在。

Answer 1

您的记录集仅包含一列 ("select distinct ts.id_justificacio")，但您正在尝试读取第二列 strActivitat = rsJustAct(1)

将所需的列添加到记录集中。

VBA：错误 3265 - "Item not found in this collection"

VBA: Error 3265 - "Item not found in this collection"

sql

ms-access

vba

office-2016