VBA: Ошибка 3265 - «Товар не найден в этой коллекции»

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 

Debugger: Ошибка подходя на линии:

strActivitat = rsJustAct(1) 

Я проверил, что между данными recordset является сохранение существует, и это делает.

Answer 1

Ваш записей содержит только один столбец ("select distinct ts.id_justificacio"), но вы пытаетесь прочитать вторую колонку strActivitat = rsJustAct(1)

Добавить столбец из милиции Recordset.