VBA:错误3265 - “此集合中找不到项目”

时间:2016-10-25 07:20:07

标签: sql vba ms-access access-vba office-2016

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保存的数据是否存在,确实存在。

1 个答案:

答案 0 :(得分:1)

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

将requred列添加到记录集。