Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Public Function basFind(RecSet As String, Token As Variant) As String
'To Return the FIELD name from the RecSet where the Token was found
'Returns "Not In This RecordSet" if not found.
'Returns the FIRST field name, and does not continue searching.
'Returns "No Such Recordset" if RecSet is not a table or query in
'the current database
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim tdf As DAO.TableDef
Dim fldList() As String
Dim strSQL As String
Dim sqlFrom As String
Dim sqlWhere As String
Dim Idx As Integer
Dim fld As Field
Dim NotQryDef As Boolean
On Error GoTo ErrHandler
Set dbs = CurrentDb
'Attempt to open as querydef
Set qdf = dbs.QueryDefs(RecSet)
'If there is an error(3265),
'TRAP it so we know 'RecSet' is NOT a query(def)
'Else, get the field list
If (NotQryDef = False) Then
ReDim fldList(qdf.Fields.Count - 1)
Do While Idx < qdf.Fields.Count
fldList(Idx) = qdf.Fields(Idx).Name
Idx = Idx + 1
Loop 'Idx
End If
'If it is a querydef, it SHOOULD NOT be a TableDef
If (NotQryDef = True) Then
Set tdf = dbs.TableDefs(RecSet)
'If there is an error, Houston, We Have a Problem
ReDim fldList(tdf.Fields.Count - 1)
Do While Idx < tdf.Fields.Count
fldList(Idx) = tdf.Fields(Idx).Name
Idx = Idx + 1
Loop 'Idx
End If
'Here, we Know that [RecSet] does exist, and
'fldList is the list of fields in RecSet
sqlFrom = " From " & RecSet & " "
sqlWhere = " = " & Chr(34) & Token & Chr(34)
Idx = 0
Do While Idx < UBound(fldList)
strSQL = "Select CStr([" & fldList(Idx) & "]) as MyField " & sqlFrom
strSQL = strSQL & " Where CStr([" & fldList(Idx) & "]) " & sqlWhere
strSQL = strSQL & ";"
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
If (Not (rst.BOF = True And rst.EOF = True)) Then
'Found
basFind = fldList(Idx)
Exit Do
End If
Idx = Idx + 1
Loop
GoTo NormExit
ErrHandler:
Select Case Err
Case Is = 94
'Invalid use of Null
Resume Next
Case Is = 3078
basFind = "No Such Recordset"
Case Is = 3265
'Item not found in this collection
NotQryDef = True
Resume Next
End Select
NormExit:
End Function