Solved Loop through records in a table that gives an error

[zelarra821]

Hi guys.

I'm trying to make a loop that goes through the records in a table, but the program doesn't respond when I run it.

This is the code:

Private Sub CalcularImporte()
Dim rstTable As DAO.Recordset
Dim rst As DAO.Recordset
Dim strSql As String
Dim ManoDeObra As Double
Dim Vehiculo As Double
Dim Apero1 As Double
Dim Apero2 As Double

    Set rstTable = CurrentDb.OpenRecordset("TGastosHoras")

        Do Until rstTable.EOF
        
            rstTable.MoveFirst
            
            rstTable.Edit

            'Mano de obra
        
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TManoDeObra" _
                    & " WHERE CampañaNumero <= " & rstTable("CampañaNumero") & " And IdTrabajador=" & Nz(rstTable("IdTrabajador"), 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 ManoDeObra = rst("Precio")
                 rstTable("ManoDeObra") = Nz(ManoDeObra, 0) * Nz(rstTable("Horas"), 0)
            End If
        
            'Vehiculos y maquinaria
        
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TVehiculosPrecios" _
                    & " WHERE CampañaNumero <= " & rstTable("CampañaNumero") & " And IdVehiculo=" & Nz(rstTable("IdVehiculo"), 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 Vehiculo = rst("Precio")
                 rstTable("Vehiculo") = Nz(Vehiculo, 0) * Nz(rstTable("Horas"), 0)
            End If
                
            'Aperos
        
            '1
            
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TAperosPrecios" _
                    & " WHERE CampañaNumero <= " & rstTable("CampañaNumero") & " And IdApero=" & Nz(rstTable("IdApero1"), 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 Apero1 = rst("Precio")
                 rstTable("ImpApero1") = Nz(Apero1, 0) * Nz(rstTable("Horas"), 0)
            End If
        
            '2
        
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TAperosPrecios" _
                    & " WHERE CampañaNumero <= " & rstTable("CampañaNumero") & " And IdApero=" & Nz(rstTable("IdApero2"), 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 Apero2 = rst("Precio")
                 rstTable("ImpApero2") = Nz(Apero2, 0) * Nz(rstTable("Horas"), 0)
            End If
                
            'Terminar rst
        
            rst.Close
        
            Set rst = Nothing
        
            'Resultado
        
            rstTable("Importe") = (Nz(ManoDeObra, 0) + Nz(Vehiculo, 0) + Nz(Apero1, 0) + Nz(Apero2, 0)) * Nz(rstTable("Horas"), 0)
            rstTable("Total") = rstTable("Importe") + rstTable("SumaDesglose")
            
            rstTable.Update
            
            rstTable.MoveNext

        Loop
        
    rstTable.Close
    
    Set rstTable = Nothing

End Sub

Let me explain a little:

This is a table where records of hours worked are kept.

What I am looking for with this loop is to update the calculations. To do this, it must be crossed with the price table of the different amounts to be searched to obtain the price corresponding to the date.

I don't want to confuse you too much, so I don't know if this explanation can be useful or if I will have to expand on it.

I need help to make this work. I don't mind going into more detail, sending screenshots, videos, whatever is necessary.

I am not sending the database because isolating the specific case, with so many related tables, is impossible.

Thank you very much.

 

[arnelgp]

because your code always goes to the First record on rstTable. (rstable.MoveFirst)

 

[CJ_London]

It ALWAYS helps to give the error description and indicate which line is generating the error

And something you can do to help yourself is to step through the code and check the values of the variables as you go.

So this is my guess - this line is in the wrong place

rstTable.MoveFirst

 

[arnelgp]

here is a modified version:

Private Sub CalcularImporte()
Dim rstTable As DAO.Recordset
Dim rst As DAO.Recordset
Dim strSql As String
Dim ManoDeObra As Double
Dim Vehiculo As Double
Dim Apero1 As Double
Dim Apero2 As Double

'ARNELGP
Dim dHoras As Double

    Set rstTable = CurrentDb.OpenRecordset("TGastosHoras")
    
    With rstable
    
        If Not (.BOF And .EOF) Then
            .MoveFirst
        End If

        Do Until .EOF
        
            dHoras = Nz(!Horas, 0)
            
            .Edit

            'Mano de obra
        
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TManoDeObra" _
                    & " WHERE CampañaNumero <= " & !CampañaNumero & " And IdTrabajador=" & Nz(!IdTrabajador, 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 ManoDeObra = rst("Precio")
                 !ManoDeObra = Nz(ManoDeObra, 0) * dHoras
            End If
        
            'Vehiculos y maquinaria
        
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TVehiculosPrecios" _
                    & " WHERE CampañaNumero <= " & !CampañaNumero & " And IdVehiculo=" & Nz(!IdVehiculo, 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 Vehiculo = rst("Precio")
                 !Vehiculo = Nz(Vehiculo, 0) * dHoras
            End If
                
            'Aperos
        
            '1
            
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TAperosPrecios" _
                    & " WHERE CampañaNumero <= " & !CampañaNumero & " And IdApero=" & Nz(!IdApero1, 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 Apero1 = rst("Precio")
                 !ImpApero1 = Nz(Apero1, 0) * dHoras
            End If
        
            '2
        
            strSql = "SELECT Top 1 Precio" _
                    & " FROM TAperosPrecios" _
                    & " WHERE CampañaNumero <= " & !CampañaNumero & " And IdApero=" & Nz(!IdApero2, 1) & "" _
                    & " ORDER BY CampañaNumero DESC"
        
            Set rst = CurrentDb.OpenRecordset(strSql)
        
            If Not (rst.EOF And rst.BOF) Then
                 Apero2 = rst("Precio")
                 !ImpApero2 = Nz(Apero2, 0) * dHoras
            End If
                
            'Terminar rst
        
            rst.Close
        
            Set rst = Nothing
        
            'Resultado
        
            !Importe = (Nz(ManoDeObra, 0) + Nz(Vehiculo, 0) + Nz(Apero1, 0) + Nz(Apero2, 0)) * dHoras
            !Total = !Importe + !SumaDesglose
            
            .Update
            
            .MoveNext

        Loop
        
        .Close
    
    End With
    
    Set rstTable = Nothing

End Sub

 

[zelarra821]

Thanks to all, guys. It's solved now.