ACC: Custom Domain Functions Similar to DFirst() and DLast()ID: Q103403
|
Moderate: Requires basic macro, coding, and interoperability skills.
By design, the DFirst() and DLast() functions always return the first and
last record that you entered in the underlying table, not the first and
last record as ordered by the table's index or the query's sort order.
DFirst() and DLast() ignore indexes, even Primary Keys, and sort orders.
Microsoft Access online Help incorrectly states:
DFirst and DLast return values from the first and last occurrence
according to the order of records in domain. If domain is an indexed
table, the order follows the current index. Otherwise, the order
follows the actual order of the records.
Create a new module within Microsoft Access and add the following
functions with the appropriate declaration section. Each command
should be entered on one line.
NOTE: In the following sample code, an underscore (_) is used as a
line-continuation character. Remove the underscore from the end of the line
when re-creating this code in Access Basic.
'-------------------------------------
' GLOBAL DECLARATION
'-------------------------------------
Option Compare Database
Option Explicit
'--------------------------------------
' Use DStart()instead of DFirst() to return
' the first sorted record in a domain.
'--------------------------------------
Function DStart (FieldName As String, DomainName As String, _
Criteria As String)
Dim MyDB As Database, Myset As Dynaset
' ERROR OUT IF THERE IS NO FIELDNAME SENT.
If Len(FieldName) = 0 Then
MsgBox "You Must Specify a Field name", , "DStart"
End
End If
' ERROR OUT IF THERE IS NO DOMAIN SENT.
If Len(DomainName) = 0 Then
MsgBox "You Must Specify a Domain name", , "DStart"
Exit Function
End If
Set MyDB = CurrentDB()
Set Myset = MyDB.CreateDynaset(DomainName)
'
If Len(Criteria) > 0 Then
Myset.Filter = Criteria
Set Myset = Myset.CreateDynaset()
End If
' IF THERE ARE NO RECORDS, RETURN THE NULL, ELSE RETURN THE VALUE
' OF THE FIRST RECORD.
If Myset.EOF Then
DStart = Null
Else
Myset.MoveFirst
DStart = Myset(FieldName)
End If
Myset.Close
MyDB.Close
End Function
'-------------------------------------------
'Use DEnd()instead of DLast() to return
' the last sorted record in a domain.
'--------------------------------------
Function DEnd (FieldName As String, DomainName As String, _
Criteria As String)
Dim MyDB As Database, Myset As Dynaset
' ERROR OUT IF THERE IS NO FIELDNAME SENT.
If Len(FieldName) = 0 Then
MsgBox "You Must Specify a Field name", , "DEnd"
Exit Function
End If
' ERROR OUT IF THERE IS NO DOMAINNAME SENT.
If Len(DomainName) = 0 Then
MsgBox "You Must Specify a Domain name", , "DEnd"
Exit Function
End If
Set MyDB = CurrentDB()
Set Myset = MyDB.CreateDynaset(DomainName)
If Len(Criteria) > 0 Then
Myset.Filter = Criteria
Set Myset = Myset.CreateDynaset()
End If
If Myset.EOF Then
DEnd = Null
Else
Myset.MoveLast
DEnd = Myset(FieldName)
End If
Myset.Close
MyDB.Close
End Function
Function DFix (ByVal T, DQuote As Integer)
'------------------------------------------------------------------
' Fixes string arguments that are passed
' to Criteria in domain functions
'
' DQuote should be TRUE or -1 if Double Quotes (") delimit Criteria
' DQuote should be FALSE or 0 if Single Quotes (') delimit Criteria
'
' For example, this gives an error
' (note the quote (') in the data)
' X="Mike's Diner"
' A=DStart("ID","Clients","Name='" & X & "'")
'
' Use either:
' X=DFix("Mike's Diner",False)
' Or:
' A=DStart("ID","Clients","Name='" & DFix(X,False) & "'")
'------------------------------------------------------------------
Dim P As Integer, OldP As Integer, Q As String * 1
If VarType(T) = 8 Then
If DQuote = 0 Then
Q = "'"
Else
Q = """"
End If
P = InStr(T, Q)
Do While P > 0
OldP = P + 2
T = Left$(T, P) & Q & Mid$(T, P + 1)
P = InStr(OldP, T, Q)
Loop
End If
DFix = T
End Function
DStart("ID","LOG","Name=Form.Name")
use:
DStart("ID","LOG","Name = '" & DFix(Name,False) & "'")
For additional information, please see the following Visual Basic article
in the Microsoft Knowledge Base:
Q178070 HOWTO: Handle Quotes and Pipes in Concatenated SQL Literals
Additional query words: ab modules docbug
Keywords : kbprg
Version : 1.0 1.1 2.0
Platform : WINDOWS
Issue type :
Last Reviewed: March 25, 1999