最新消息:雨落星辰是一个专注网站SEO优化、网站SEO诊断、搜索引擎研究、网络营销推广、网站策划运营及站长类的自媒体原创博客

How to make DLookup faster in Access VBA? - Stack Overflow

programmeradmin0浏览0评论

Please bear with me. I am still new to Access VBA.

TBL_Orders is an external source = SharePoint list linked where entries are now 5,000+ and will keep having more entries.

Ordered_By is a field of the names of the persons who made orders.

txtTicket is a textfield in the form which accepts numbers that when matched in its ID of TBL_Orders, txtOrderedBy displays the correct name of the person.

I have here a DLookup function that works very well and this is the only DLookup coded in the whole form.

Private Sub txtTicket_AfterUpdate()
    txtOrderedBy.Value = Nz(DLookup("[Ordered_By]", "[TBL_Orders]", "[ID] = " & [txtTicket]))
End Sub

However, the displaying of the name of the person in txtOrderedBy.Value per afterupdate of txtTicket.value has a delay of 7-8 seconds.

I tried to duplicate the external table to make it like a local table and check if the reason of the delay is the source being external but I get an error that says, 'Couldn't find the ".'

So I was not able to copy and test it.

But what could be causing the delay and how to make DLookup display a value instantly after update of txtTicket textfield?

Your help is greatly appreciated.

Please bear with me. I am still new to Access VBA.

TBL_Orders is an external source = SharePoint list linked where entries are now 5,000+ and will keep having more entries.

Ordered_By is a field of the names of the persons who made orders.

txtTicket is a textfield in the form which accepts numbers that when matched in its ID of TBL_Orders, txtOrderedBy displays the correct name of the person.

I have here a DLookup function that works very well and this is the only DLookup coded in the whole form.

Private Sub txtTicket_AfterUpdate()
    txtOrderedBy.Value = Nz(DLookup("[Ordered_By]", "[TBL_Orders]", "[ID] = " & [txtTicket]))
End Sub

However, the displaying of the name of the person in txtOrderedBy.Value per afterupdate of txtTicket.value has a delay of 7-8 seconds.

I tried to duplicate the external table to make it like a local table and check if the reason of the delay is the source being external but I get an error that says, 'Couldn't find the ".'

So I was not able to copy and test it.

But what could be causing the delay and how to make DLookup display a value instantly after update of txtTicket textfield?

Your help is greatly appreciated.

Share Improve this question asked Feb 3 at 5:12 ShielaShiela 7491 gold badge9 silver badges23 bronze badges 5
  • Linked Sharepoint lists are slow. A local table will be very fast if you apply an index on the field to search. Of course, you must proper code or method to duplicate it, and that is certainly possible, but as you haven't revealed your code, no one can help you with this. – Gustav Commented Feb 3 at 6:36
  • @Gustav i havent written a code to copy and paste the table. i did right clicked on it and copied then right clicked again to paste the structure and data only. but the local table was only supposed to be part of testing. now that i know SP lists are slow as you mentioned. i understand now. ty – Shiela Commented Feb 3 at 7:55
  • OK, but the error box posted seems not related to DLookup. Perhaps something else is going on? – Gustav Commented Feb 3 at 9:15
  • 1 @Gustav, not related. just included it in case someone will ask if i have tried dlookup in a local table. not really that important / highlighted to be resolved. just looking for other ways other than dlookup if there's much more faster way. but since value is from an SP list (which is making dlookup slow), i think i understand it now – Shiela Commented Feb 3 at 9:35
  • 1 Make txtTicket a combobox that includes Ordered_By field in RowSource. Expression in textbox references combobox column: =[cbxTicket].Column(1). No VBA needed. – June7 Commented Feb 8 at 18:09
Add a comment  | 

1 Answer 1

Reset to default 1

I'm not sure if it will help in your case but I use in my databases a DLookup replacement (incl. the other D-functions) based on recordsets. This is much faster than the built in functions. Names are similar and parameters are the same, just replace D by T in the name so that DLookup becomes TLookup.

Here is the code to be copied in a new module:

Option Compare Database   'Use database order for string comparisons
Option Explicit

' Replacement Functions for DLookup, DCount & DSum , DMax & DMin
'
' Notes:
' Any spaces in field names or table names will probably result in an error
' If this is the case then provide the brackets yourselfs, e.g.
' tLookup("My field","My table name with spaces in") will blow big time
' tLookup("[My field]","[My table name with spaces in]") will be ok
' These functions will not bracket the field/table names for you so as to
' remain as flexible as possible, e.g. you can call tSum() to add or multiply or
' whatever along the way, e.g. tSum("Price * Qty","Table","criteria") or if you're
' feeling adventurous, specify joins and the like in the table name.
'
' See tLookup function for changes from last version
'
' Uses DAO
'
' VB Users
' Get rid of tLookupParam() and the case in the error trapping
' of tLookup() that calls it, this uses a function built-in to
' MS-Access.

Public Enum tLookupReset
    tLookupDoNothing = 0
    tLookupRefreshDb = 1
    tLookupSetToNothing = 2
End Enum


Function tCount(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Long
    
    ' Function tCount
    ' Purpose: Replace DCount, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best

    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tCount = tLookup("count(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset)
    
End Function
Function tMax(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Variant
    
    ' Function tMax
    ' Purpose: Replace DMax, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best

    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tMax = tLookup("max(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset)
    Exit Function
End Function

Function tMin(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Variant
    
    ' Function tMin
    ' Purpose: Replace DMin, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best
    
    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tMin = tLookup("min(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset)
    
End Function

Function tSum(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Double
    
    ' Function tSum
    ' Purpose: Replace DSum, which is slow on attached tables
    ' Created: 1 Feb 1996 T.Best

    ' TB 28 Jan 2003
    ' Make this call TLookup() so we'll only need concentrate on
    ' one set of error handling code
    tSum = Nz(tLookup("sum(" & pstrField & ")", pstrTable, pstrCriteria, pdb, pLookupReset), 0)

End Function


Function tLookup(pstrField As String, pstrTable As String, Optional pstrCriteria As String, Optional pdb As Database, Optional pLookupReset As tLookupReset = tLookupDoNothing) As Variant
    On Error GoTo tLookup_Err
    
    ' Function  tLookup
    ' Purpose:  Replace DLookup, which is slow on attached tables
    '           For where you can't use TbtLookup() if there's more
    '           than one field in the criteria or field is not indexed.
    ' Created:  9 Jan 1996 T.Best
    ' Mod       1 Feb 1996 T.Best
    '   Error Trapping brought in line with this procurement system.
    
    ' Mod       13 Apr 1999 T.Best
    '   Lookups to ODBC datasource use the gdbSQL database object.
    
    ' Mod       14 Apr 1999 T.Best
    '   gdbSQL object no good if doing lookup on a local table, DOH!
    
    ' Mod       11 Jan 2002 G.Hughes
    '   Removed gdbSQL as it was slowing tLookup Down.!!!!!!!!!
    
    ' Mod       Unlogged
    '   Someone put gdbSQL back in
    
    ' Mod       27 Jan 2003 T. Best
    '   Optimise gdbSQL to use Pass-through, it wickedly fast
    
    ' mod       13 Mar 2003
    '   Taken out gdbSQL for redistribution and replaced
    '   the DbEngine with CurrentDB to avoid the now well
    '   documented (in CDMA) DbEngine reference bug.
    '   Added tLookupReset Parameter which does the following
    '   tLookupDoNothing    Do nothing
    '   tLookupRefreshDb    Refreshes collections on the db
    '   tLookupCloseDb      Sets the db to nothing
    '   Also added a db parameter so programmer can call it using
    '   their own db variable, which may be something they opened
    '   elsewhere (Idea by D.Fenton in CDMA).
    
    Static dbLookup As DAO.Database
    Dim rstLookup As DAO.Recordset
    Dim varValue As Variant
    Dim strSQL As String
    
    ' if calling function sends a db then we'll use that
    If Not pdb Is Nothing Then
        Set dbLookup = pdb
    Else
        ' If our db vari is not initialised or the calling
        ' process wants the db objects refreshed then we'll
        ' set the db var using CurrentDb()
        If dbLookup Is Nothing Or pLookupReset = tLookupRefreshDb Then
            If Not dbLookup Is Nothing Then
                Set dbLookup = Nothing
            End If
            Set dbLookup = CurrentDb()
        End If
    End If
    
    
    ' If no criteria specified then we don't even want to get as far
    ' as putting the word "where" in there
    If Len(pstrCriteria) = 0 Then
        strSQL = "Select " & pstrField & " From " & pstrTable
    Else
        ' handle those instances where you call tLookup using a field
        ' on a form but can't be bothered to check whether it's null
        ' first before calling, e.g. =tLookup("col1","table","col2=" & txtWhatever)
        ' if txtWhatever was null it would cause an error, this way if there's
        ' nothing after the "=" sign then we assume it was null so we'll make
        ' it look for one.
        ' You may want to handle this differently and avoid looking up
        ' data where the criteria field is null and just always return a
        ' null in which case you'd need to add code to avoid doing the
        ' lookup altogether or just change the criteria to " = Null" as
        ' nothing will ever match with " = Null" so the function would
        ' return null.
        If Right(RTrim(pstrCriteria), 1) = "=" Then
            pstrCriteria = RTrim(pstrCriteria)
            pstrCriteria = Left(pstrCriteria, Len(pstrCriteria) - 1) & " is Null"
        End If
        
        ' build our SQL string
        strSQL = "Select " & pstrField & " From (" & pstrTable & ") Where " & pstrCriteria
    End If
    
    ' now open a recordset based on our SQL
    Set rstLookup = dbLookup.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly)
    
    ' chekc if we returned anything at all
    If Not rstLookup.BOF Then
        ' return the value returned in the query
        varValue = rstLookup(0)
    Else
        ' no records matched, return a null
        varValue = Null
    End If
    tLookup = varValue

tLookup_Exit:
    On Error Resume Next
    rstLookup.Close
    Set rstLookup = Nothing
    Exit Function

tLookup_Err:
    Select Case Err
        Case 3061
            ' Error 3061 - Too Few Parameters - Expected x, you know those programmers
            ' should really parse out those form object references for themselves but
            ' we can try to retrieve the situation here by evaluating any parameters
            ' we find in the SQL string.
            tLookup = tLookupParam(strSQL, dbLookup)
        Case Else
            MsgBox Err.Description, 16, "Error " & Err & " in tLookup() on table " & pstrTable & vbCr & vbCr & "SQL=" & strSQL
        End Select
    Resume tLookup_Exit
    Resume

End Function

Function tLookupParam(pstrSQL As String, pdb As Database) As Variant
    ' Called when tLookup, tCount, tMax, tMin or tSum have bombed out
    ' with an expected parameter error, will go and create a querydef
    ' and then attempt to evaluate the parameters
    ' Error Trapped: 12/02/1999 10:21:24 Admin
    On Error GoTo tCountParam_Err
    Dim qdf As DAO.QueryDef
    Dim rsT As DAO.Recordset
    Dim prm As DAO.Parameter
    Dim strMsg As String
    Dim i As Long
    
    Set qdf = pdb.CreateQueryDef("", pstrSQL)
    strMsg = vbCr & vbCr & "SQL=" & pstrSQL & vbCr & vbCr
    For i = 0 To qdf.Parameters.count - 1 ' Each prm In qdf.Parameters
        Set prm = qdf.Parameters(i)
        strMsg = strMsg & "Param=" & prm.Name & vbCr
        prm.Value = Eval(prm.Name)
        Set prm = Nothing
    Next
    Set rsT = qdf.OpenRecordset()
    rsT.MoveFirst
    tLookupParam = rsT(0)
    
tCountParam_Exit:
    On Error Resume Next
    Set prm = Nothing
    rsT.Close
    Set rsT = Nothing
    qdf.Close
    Set qdf = Nothing
    Exit Function
    
tCountParam_Err:
    Select Case Err
        Case Else
            MsgBox Err.Description & strMsg, 16, "Error #" & Err & " In tLookupParam()"
    End Select
    Resume tCountParam_Exit
    Resume
End Function
发布评论

评论列表(0)

  1. 暂无评论