databasevbams-accessfiltered-lookupdlookup

Find and Replace Value in Table From DLookup Multiple Criteria VBA

I'm start to do programming in Access, and I really need help!!

My objective is to create a module that is run in "tbCustoProjeto" table and rewrite the field "Valor HH" values based on Dlookup. I found some solution (by azurous) who I think will solve this, but when I run the code, is returned

"object-required-error".

Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
Dim i As Integer
Dim value As Variant
Dim HHTotal As Double
Set HHTotal = DLookup("[CustoTotalNivel]", "tbNivelNome2", "nUsuario='" & tbCustoProjeto!NumUsuario & "'" & "AND Numeric<=" & tbCustoProjeto!DataNumero)

'initated recordset obejct
objRecordset.ActiveConnection = CurrentProject.Connection
Call objRecordset.Open("tbCustoProjeto", , , adLockBatchOptimistic)
'find the target record
While objRecordset.EOF = False
'If objRecordset.Fields.Item(13).value > 0 Then
objRecordset.Fields.Item(13).value = HHTotal
objRecordset.UpdateBatch
'exit loop
'objRecordset.MoveLast
objRecordset.MoveNext
'End If
Wend
MsgBox ("Pesquisa Finalizada")
End Sub

Print of tbCustoProjeto

enter image description here

Print of tbNivelNome2

enter image description here

Please, someone can tell me where is the error? I don't know what to do.

Solution

  • Cannot reference a table directly like that for dynamic parameter. DLookup should pull dynamic criteria from recordset and within loop. Don't use apostrophe delimiters for number type field parameter.

    Remove unnecessary concatenation. 

    Sub redefineHH()
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
objRecordset.Open "tbCustoProjeto", CurrentProject.Connection, , adLockBatchOptimistic
While objRecordset.EOF = False
    objRecordset.Fields.Item(13) = DLookup("[CustoTotalNivel]", "tbNivelNome2", _
        "nUsuario=" & objRecordset!NumUsuario & " AND Numeric <=" & objRecordset!DataNumero)
    objRecordset.UpdateBatch
    objRecordset.MoveNext
Wend
MsgBox ("Pesquisa Finalizada")
End Sub