by Dipen Anovadia (19 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Tue 27th December 2005
Date Added: Mon 8th February 2021
Rating: (1 Votes)
Gets the value of any field with given criteria
API Declarations
'NOTE: db is assumed for Database
'And DAO is used as Reference
sTable As String, sCheckField As String, _
vCheckValue As Variant, sTargetField As String, _
Optional sComparisionChars As String = "=", _
Optional bNotOperator As Boolean = False, _
Optional sExtraSQL As String = "", _
Optional vDefaultReturn As Variant = -1, _
Optional lOUT_ERROR As Long = 0 _
) As Variant
Dim r As Recordset, s As String
On Error GoTo errGFV
If Not (sComparisionChars = "=" Or _
sComparisionChars = ">" Or _
sComparisionChars = "<" Or _
sComparisionChars = ">=" Or _
sComparisionChars = "=>" Or _
sComparisionChars = "<=" Or _
sComparisionChars = "=<") Then
lOUT_ERROR = -1
Exit Function
End If
GetFieldValue = vDefaultReturn
s = "SELECT " & sTargetField & " " & _
"FROM " & sTable & " " & _
"WHERE " & IIf((sExtraSQL = ""), "", sExtraSQL & " AND ") & _
IIf(bNotOperator, "NOT ", "") & sCheckField & sComparisionChars
If VarType(vCheckValue) = vbString Then
s = s & "'" & vCheckValue & "'"
ElseIf VarType(vCheckValue) = vbDate Then
s = s & "#" & vCheckValue & "#"
Else
s = s & vCheckValue
End If
Set r = dB.OpenRecordset(s)
If r.EOF Then
Set r = Nothing
Exit Function
End If
GetFieldValue = r.Fields(0).Value
Set r = Nothing
Exit Function
errGFV:
lOUT_ERROR = Err.Number
Err.Clear
GetFieldValue = vDefaultReturn
Set r = Nothing
End Function