How to use Elookup

Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc
Hankwembo Christopher,FCCA,FZICA,CIA,MAAT,B.A.Sc used Ask the Experts™
on
For those who are familiar with Elookup  in Ms Access, see how you can help on the code below:

"Description", Elookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))

Open in new window


The above  code gives an error Elookup 3061 but the same code with Dlookup works perfect, I just want to see whether its true that Elookup is twice faster than Dlookup.

I have put the code below in a module:

Option Compare Database
Option Explicit

Public Function Elookup(Expr As String, Domain As String, Optional Criteria As Variant, _
    Optional OrderClause As Variant) As Variant
On Error GoTo Err_ELookup
    'Purpose:   Faster and more flexible replacement for DLookup()
    'Arguments: Same as DLookup, with additional Order By option.
    'Return:    Value of the Expr if found, else Null.
    '           Delimited list for multi-value field.
    'Author:    Allen Browne. allen@allenbrowne.com
    'Updated:   December 2006, to handle multi-value fields (Access 2007 and later.)
    'Examples:
    '           1. To find the last value, include DESC in the OrderClause, e.g.:
    '               ELookup("[Surname] & [FirstName]", "tblClient", , "ClientID DESC")
    '           2. To find the lowest non-null value of a field, use the Criteria, e.g.:
    '               ELookup("ClientID", "tblClient", "Surname Is Not Null" , "Surname")
    'Note:      Requires a reference to the DAO library.
    Dim db As DAO.Database          'This database.
    Dim rs As DAO.Recordset         'To retrieve the value to find.
    Dim rsMVF As DAO.Recordset      'Child recordset to use for multi-value fields.
    Dim varResult As Variant        'Return value for function.
    Dim strSql As String            'SQL statement.
    Dim strOut As String            'Output string to build up (multi-value field.)
    Dim lngLen As Long              'Length of string.
    Const strcSep = ","             'Separator between items in multi-value list.

    'Initialize to null.
    varResult = Null

    'Build the SQL string.
    strSql = "SELECT TOP 1 " & Expr & " FROM " & Domain
    If Not IsMissing(Criteria) Then
        strSql = strSql & " WHERE " & Criteria
    End If
    If Not IsMissing(OrderClause) Then
        strSql = strSql & " ORDER BY " & OrderClause
    End If
    strSql = strSql & ";"

    'Lookup the value.
    Set db = DBEngine(0)(0)
    Set rs = db.OpenRecordset(strSql, dbOpenForwardOnly)
    If rs.RecordCount > 0 Then
        'Will be an object if multi-value field.
        If VarType(rs(0)) = vbObject Then
            Set rsMVF = rs(0).Value
            Do While Not rsMVF.EOF
                If rs(0).Type = 101 Then        'dbAttachment
                    strOut = strOut & rsMVF!FileName & strcSep
                Else
                    strOut = strOut & rsMVF![Value].Value & strcSep
                End If
                rsMVF.MoveNext
            Loop
            'Remove trailing separator.
            lngLen = Len(strOut) - Len(strcSep)
            If lngLen > 0& Then
                varResult = Left(strOut, lngLen)
            End If
            Set rsMVF = Nothing
        Else
            'Not a multi-value field: just return the value.
            varResult = rs(0)
        End If
    End If
    rs.Close

    'Assign the return value.
    Elookup = varResult

Exit_ELookup:
    Set rs = Nothing
    Set db = Nothing
    Exit Function

Err_ELookup:
    MsgBox Err.Description, vbExclamation, "ELookup Error " & Err.Number
    Resume Exit_ELookup
End Function

Open in new window





Elookup.png
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
John TsioumprisSoftware & Systems Engineer

Commented:
Without sample data we are only guessing but for start i don't like this
"Description", Elookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
if you are converting to string then it should be quoted e.g. like this
"Description", Elookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID ='" & CStr(i) & "'")
maybe you want Clng instead of Cstr
"Description", Elookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CLng(i) ) 

Open in new window

Ryan ChongSoftware Team Lead

Commented:
make sure both Me.InvoiceID and i contain values?
Ryan ChongSoftware Team Lead

Commented:
can you share the whole codes for:

"Description", Elookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))

Open in new window


?

it seems that error is not come from the Elookup function
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Ok

Here is my full code:

Private Sub CmdConertJson_Click()
'  Const SQL_SELECT As String = "SELECT * FROM QryJson;"
    
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim fld As DAO.Field
  Dim qdf As DAO.QueryDef
  Dim prm As DAO.Parameter
  Dim root As Dictionary
    Set root = New Dictionary

    Dim transaction As Dictionary
    Dim transactions As Collection
    Dim item As Dictionary
    Dim items As Collection
    Dim invoice As Dictionary
    Dim invoices As Collection
    Dim Tax As Collection
    Dim i As Long
    Dim j As Long
    Dim t As Long
    Set transactions = New Collection
  Set db = CurrentDb
  Set qdf = db.QueryDefs("QryJson")
For Each prm In qdf.Parameters
    prm = Eval(prm.Name)
Next prm
Set rs = qdf.OpenRecordset()

Set qdf = Nothing
 rs.MoveFirst
    Do While Not rs.EOF
        Set transaction = New Dictionary
        transaction.Add "PosVendor", "Nector Prime Accounting Solutions"
        transaction.Add "PosSerialNumber", Me.CboEfds.Column(1)
        transaction.Add "IssueTime", Me.txtjsonDate
        transaction.Add "TransactionTyp", Me.TransactionType
        transaction.Add "PaymentMode", Me.PaymentMode
        transaction.Add "SaleType", Me.SalesType
        transaction.Add "LocalPurchaseOrder", Me.LocalPurchaseOrder
        transaction.Add "Cashier", Me.Cashier
        transaction.Add "BuyerTPIN", Me.BuyerTPIN
        transaction.Add "BuyerName", Me.BuyerName
        transaction.Add "BuyerTaxAccountName", Me.BuyerTaxAccountName
        transaction.Add "BuyerAddress", Me.BuyerAddress
        transaction.Add "BuyerTel", Me.BuyerTel
        transaction.Add "OriginalInvoiceCode", Me.OrignalInvoiceCode
        transaction.Add "OriginalInvoiceNumber", Me.OrignalInvoiceNumber

        '--- loop over all the items
        Dim itemCount As Long
        itemCount = Me.txtsquence
        Set items = New Collection
        For i = 1 To itemCount
            Set item = New Dictionary
            item.Add "ItemID", i
            item.Add "Description", Elookup("ProductName", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "BarCode", Elookup("ProductID", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "Quantity", Elookup("Quantity", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "UnitPrice", Elookup("unitPrice", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            item.Add "Discount", Elookup("Discount", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            '--- loop over all the taxes
            Dim taxCount As Long
            taxCount = 1
            Set Tax = New Collection
            Dim strTaxes As Boolean
            strTaxes = Elookup("CGControl", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            '--- loop over all the invoices
            Dim invoiceCount As Long
            invoiceCount = 1
            Set invoices = New Collection
            For j = 1 To invoiceCount
                            
                For t = 1 To taxCount
            Next t
            item.Add "Taxable", Tax
            
            Tax.Add Elookup("TaxClassA", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            Tax.Add Elookup("TaxClassB", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
            
                item.Add "Total", Elookup("TotalAmount", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
                item.Add "IsTaxInclusive", strTaxes
                item.Add "RRP", Elookup("RRP", "QryJson", "InvoiceID =" & Me.InvoiceID & " AND ItemesID =" & CStr(i))
                
            Next j
            
            
            items.Add item
        Next i
        transaction.Add "Items", items
        
        rs.MoveNext
    Loop
    
    root.Add "", transaction

    Dim json As String
    json = JsonConverter.ConvertToJson(transaction, Whitespace:=3)
    Open "C:\Users\chris.hankwembo\Desktop\Ca Premier VBA Code\Confirmed\testfiles.txt" For Append As #1
Print #1, json
Close #1
   
End Sub

Open in new window

Hi,

using DLookup or ELookup in your case on this way is the slowliest possible method.

You use that in a loop where also each value is taken from a single query - horrible.

All are coming from the same query and using the same parameters - so why do you not simply create a recordset with ALL these fields and looping through all fields of the recordset getting all the values in one query? And if you want to get all records where the InvoiceID is between 1 and itemCount like in your "For" loop, you could extend the query by not asking for ONE InvoiceID but "InvoiceID BETWEEN 1 AND itemCount" (where "itemCount" would be replaced with the value of your variable). Then you can loop through all records with a Do-Loop and you don't need the For-Loop anymore. Your code would get a lot shorter and faster and you don't need DLookup and also not ELookup.

ELookup is also not optimal because all the variables are built inside the function - it would be better to use module global variables and fill them once, then they can be reused which makes especially usage in loops faster. But whenever you use these Lookup functions in loops normally your code is wrong. These functions should be used only where you quickly want to get one single value from a table or query, not less and not more. Whenever you need more than one row or more than one field, always use a recordset.

In case of INSERT/DELETE/UPDATE it should also better be no recordset and instead a query to solve that, just to mention that recordsets should also be avoided whenever possible.

Cheers,

Christian
ste5anSenior Developer

Commented:
You're still mixing at least three steps - data retrieval, data processing and data output - which should be separated for better error handling or better code-reuse or better readability..

How do you expect to identify errors in such a mixed up method?

When you would work with separate procedures, you would instantly see some flaws:

- The transactions dictionary is exported, not the root dictionary.
- The transactions dictionary is (re)created inside of your loop. Thus you may have multiple rows in your source data, but you'll export only the last.
- File handles are a resource, which can be in-use. Use always FreeFile to get one.
- I would always read data only from recordsets, never from a form. Reading values from a form can lead to exported values which are not stored in your database.

Private Sub CmdConertJson_Click()

  Const FILE_NAME As String = "C:\Users\chris.hankwembo\Desktop\Ca Premier VBA Code\Confirmed\testfiles.txt"

  Dim TransactionsDictionary As Scripting.Dictionary
  Dim TransactionsRecordset As DAO.Recordset
  Dim ItemsRecordset As DAO.Recordset

  If RetrieveData(TransactionsRecordset, ItemsRecordset) Then
    If ProcessData(Transactions, ItemsRecordset, TransactionsDictionary) Then
      If OutputData(TransactionsDictionary, FILE_NAME) Then
       MsgBox "Yay.", vbInformation + vbOkOnly
      Else
        MsgBox "Error while processing data.", vbCritical + vbOkOnly
      End If

      Set TransactionsDictionary = Nothing
    Else
      MsgBox "Error while processing data.", vbCritical + vbOkOnly
    End If

    Set TransactionsRecordset = Nothing
    Set ItemsRecordset = Nothing
  Else
    MsgBox "Error while retrieving data.", vbCritical + vbOkOnly
  End If

End Sub

Private Function RetrieveData(ByRef OTransactionsRecordset As DAO.Recordset, ByRef OItemsRecordset DAO.Recordset) As Boolean

  On Local Error GoTo LocalError

  RetrieveData = False
  Set TransactionsRecordset = Me.RecordsetClone
  Set ItemsRecordset = CurrentDbC.OpenRecordset("QryJson")
  RetrieveData = True
  Exit Function

LocalError:
  Debug.Print "RetrieveData(): Error " & Err.Number & " retrieving data." & vbCrLf & vbTab & Err.Description

End Function

Private Function ProcessData(ByRef CTransactionsRecordset As DAO.Recordset, ByRef CItemsRecordset DAO.Recordset, ByRef OTransactionsDictionary AS Scripting.Dictionary) As Boolean

  On Local Error GoTo LocalError

  'All declaraions are in done here. Not inline in loop bodies.
  'Dim ...

  ProcessData = False
  CTransactionsRecordset.MoveFirst
  Do While Not CTransactionsRecordset.EOF
    Set OTransactionsDictionary = New Scripting.Dictionary 'REALLY?
    OTransactionsDictionary.Add "LocalPurchaseOrder", CTransactionsRecordset![LocalPurchaseOrder]
    OTransactionsDictionary.Add "TransactionTyp", CTransactionsRecordset![TransactionType]
    itemCount = CTransactionsRecordset![txtsquence]
    Set items = New Scripting.Collection
    For i = 1 To itemCount
      Set item = New Dictionary
      CItemsRecordset.FindFirst "InvoiceID = " & CTransactionsRecordset![InvoiceID] & " AND ItemesID = " & CStr(i)
      If Not CItemsRecordset.NoMatch Then
        item.Add "Description", CItemsRecordset![ProductName]
        item.Add "BarCode", CItemsRecordset![ProductID]
        items.Add item
      End If
    Next i

    OTransactionsDictionary.Add "Items", items
    Set items = Nothing
    CTransactionsRecordset.MoveNext
  Loop

  ProcessData = True
  Exit Function

LocalError:
  Debug.Print "ProcessData(): Error " & Err.Number & " processing data." & vbCrLf & vbTab & Err.Description

End Function

Private Function OutputData(ByRef CTransactionsDictionary AS Scripting.Dictionary, ByVal CFileName As String) As Boolean

  On Local Error GoTo LocalError

  Dim FileHandle As Long
  Dim Json As String

  OutputData = False
  Json = JsonConverter.ConvertToJson(transaction, Whitespace:=3)
  FileHandle = FreeFile
  Open CFileName For Append As #FileHandle
  Print #FileHandle, Json
  Close #FileHandle
  OutputData = True
  Exit Function

LocalError:
  Debug.Print "OutputData(): Error " & Err.Number & " outputting data." & vbCrLf & vbTab & Err.Description

End Function

Open in new window

Is this kind of coding the ultimate wisdom? Surely not.. but it is better than throwing everything into a single method.
ste5an

As much as I appreciate your contribution, just for sake of other novice users who will try to use it , the code has a lot of errors , such that to correct them require a great deal of time and its nowhere near to the solution required.

Anyway

Thank you
Chris
John TsioumprisSoftware & Systems Engineer

Commented:
I think the code of @Ste5an is just fine...the user just have to adapt it to needs...
ste5anSenior Developer

Commented:
The code is an outline. I've just hacked it into an text editor. It is not meant to run instantly. It should show you how to structure code.

such that to correct them require a great deal of time

That's life and called programming and debugging.

and its nowhere near to the solution required.
My post was not an answer to your question nor indented to be one. It was meant to just show you, that I'm not surprised that there are errors. And that the error itself is not visible right from the spot due to the poor code structure.

Well, I'm trying to teach you how to fish, but it really seems that I'm failing miserably or you just want a fish.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial