Form E-Lookup or OpenArg Locks-up - computer specific (1 Viewer)

[Pisteuo]

I am using A2003. The below VBA searches for a record. If the record is not fourd the VBA opens another form using an OpenArg.

The operation works well on my computer.

But it locks-up 10% of the time on user 2's computer, and 95% on user 3's computer.

I have changed the DB's open mode to "exclusive" and I have ensured user 3 is the only one in the application. User 3 is running a 3-4 year old computer.

The operation locks-up before showing the message box. We have to ctr/alt/delete.

Thank you for your help.

Private Sub cmbTask_AfterUpdate()

On Error GoTo Err_cmbTask_AfterUpdate

Dim varExists As Variant

varExists = ELookup("fldTask", "tblTemplate", "fldTask = '" & [cmbTask] & "'")

If varExists > 0 Then
GoTo Refresh

Else

MsgBox ("Please take a moment to create a template for " & cmbTask & ".")
DoCmd.OpenForm "frmTemplate", acNormal, , , acFormAdd, acDialog, cmbTask
GoTo Refresh

End If

Refresh:
Forms!frmLog.Refresh

Exit_cmbTask_AfterUpdate:
Exit Sub
Err_cmbTask_AfterUpdate:
MsgBox Err.Description
Resume Exit_cmbTask_AfterUpdate

End Sub

 

[HiTechCoach]

ELookup() is not a built-in/standard Access. There is a DLookup() ficntion.

I will assume the Elookup() is a custom function. If this is True, then please post the VBA code for this function. Mu Guess is that this function is taking so long to execute that it as to "hang".

Alos:
If you check the Task Manager, does MSACCESS.EXE still show CPU usage? If yes, then it is still doing something and has not stopped running.

 

[Pisteuo]

This is the E-Lookup module code (created by Allen Browne). Thanks again.

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.)
'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

 

[HiTechCoach]

I normally use DCount() to see if a record exists with a valu, not Dlookup.


Also, is the field fldTask index in the table tblTemplate? This will really help the speed.

If you use ctrl-Break to stop the code execution after it "locks-up", what line is highlighted?

When it locks-up, is does MSACCESS.EXE still get CPU time?

 

[missinglinq]

I agree that DCount() is more appropriate for this task, as Coach has said.

Having said that, when apps run fine on one machine and not on another or run fine in one version and not when run under a newer version, the first thing you have to think about are missing references. In this case I would tend to think it's the Microsoft DAO 3.6 Object Library, since Allen's code uses a DAO recordset.

Here are Doug Steele's detailed instructions on how to troubleshoot the problem:

http://www.accessmvp.com/DJSteele/AccessReferenceErrors.html

 

[fuschimir]

Hello

That is so nice collection.Well after finding your this comment there is no need for any book reading search of last few years.I like your idea for distributing the books by years.

 

[Pisteuo]

Thank you for the good feedback.

I just experienced the problem on my computer. I first experienced it after substituting DCount. I then experienced it in my backup file that still had ELookUp. Microsoft DAO 3.6 Object Library is referenced. The field is indexed.

I wanted to share one more clue before delving into Steele's article.

The form being opened in the operation can also be opened manually from a button. This button frequently fails to open the form, though the application does not hang up. This error has happened upon opening the file, before any other form operation has executed. The VBA is standard from the wizard.

Private Sub btnOpen_Click()
On Error GoTo Err_btnOpen_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frmTemplate"

stLinkCriteria = "[fldTask]=" & "'" & Me![cmbTask] & "'"
DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_btnOpen_Click:
Exit Sub

Err_btnOpen_Click:
MsgBox Err.Description
Resume Exit_btnOpen_Click

End Sub

I will continue working my way through Steele's article.