2 alternatives
Function GetRecord(ByVal adoRecSet As ADODB.Recordset, ByVal outputColumnName As String, ByVal filterColumnName As String, ByVal filterValue As Variant) As Variant
'Description: Gets the value of one record's one column
'Input: Recordset object; Output field's name; Filter field's name; filter value
'Output: Value of field if unique record found, otherwise FALSE
'****** DEKLARÁCIÓK ********************
Dim filterString As String
'*******************************************
' Different FilterString based on field type
Select Case adoRecSet.Fields(filterColumnName).Type
Case adVarNumeric, adInteger, adTinyInt, adSmallInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt, adDecimal, adSingle, adDouble, adBigInt, adDate, adFileTime, adNumeric
filterString = CStr(filterColumnName & "=" & filterValue)
Case adVarChar, adChar, adLongVarChar, adLongVarWChar, adVarWChar, adWChar
filterString = CStr(filterColumnName & "='" & filterValue & "'")
Case adDBDate, adDBTimeStamp
filterString = CStr(filterColumnName & "=#" & filterValue & "#")
'filterString = CStr(FilterColumnName & "= #" & year(datevalue(FilterValue)) & "-" & right("00" & month(datevalue(FilterValue)),2) & "-" & right("00" & day(datevalue(FilterValue)),2) & "#"
'filterString = CStr(FilterColumnName & "= #" & year(datevalue(FilterValue)) & "-" & right("00" & month(datevalue(FilterValue)),2) & "-" & right("00" & day(datevalue(FilterValue)),2) & " " & Right("00" & Hour(datevalue(FilterValue)),2) & ":" & Right("00" & Minute(datevalue(FilterValue)),2) & ":" & Right("00" & Second(datevalue(FilterValue)),2) & "#"
End Select
adoRecSet.Filter = filterString
' Validate output
Select Case adoRecSet.RecordCount
Case 0
'nothing found
Debug.Print "No output for the filter" & vbNewLine & "WHERE " & filterString
GetRecord = False
Case 1
'unique record -> success
GetRecord = adoRecSet.Fields(outputColumnName).Value
Case Else
'multiple records found
Debug.Print "Multiple records found for the filter" & vbNewLine & "WHERE " & filterString
GetRecord = False
End Select
End Function
Function GetRecord2(ByVal adoRecSet As ADODB.Recordset, ByVal outputColumnName As String, ByVal filterColumnName As String, ByVal filterValue As Variant) As Variant
'Description: Gets the value of one record's one column
'Input: Recordset object; Output field's name; Filter field's name; filter value
'Output: Value of field if unique record found, otherwise FALSE
'****** DEKLARÁCIÓK ********************
Dim filterString As String
'*******************************************
' Mezõ típusa alapján különbözõ FilterString
Select Case adoRecSet.Fields(filterColumnName).Type
Case adVarNumeric, adInteger, adTinyInt, adSmallInt, adUnsignedInt, adUnsignedSmallInt, adUnsignedTinyInt, adDecimal, adSingle, adDouble, adBigInt, adDate, adFileTime, adNumeric
filterString = CStr(filterColumnName & "=" & filterValue)
Case adVarChar, adChar, adLongVarChar, adLongVarWChar, adVarWChar, adWChar
filterString = CStr(filterColumnName & "='" & filterValue & "'")
Case adDBDate, adDBTimeStamp
filterString = CStr(filterColumnName & "=#" & filterValue & "#")
'filterString = CStr(FilterColumnName & "= #" & year(datevalue(FilterValue)) & "-" & right("00" & month(datevalue(FilterValue)),2) & "-" & right("00" & day(datevalue(FilterValue)),2) & "#"
'filterString = CStr(FilterColumnName & "= #" & year(datevalue(FilterValue)) & "-" & right("00" & month(datevalue(FilterValue)),2) & "-" & right("00" & day(datevalue(FilterValue)),2) & " " & Right("00" & Hour(datevalue(FilterValue)),2) & ":" & Right("00" & Minute(datevalue(FilterValue)),2) & ":" & Right("00" & Second(datevalue(FilterValue)),2) & "#"
End Select
' default value
GetRecord2 = False
With adoRecSet
.Find filterString, 0, adSearchForward, adBookmarkFirst
'if no record found then cursor reaches EOF
Do While Not .EOF
If GetRecord2 = False Then
GetRecord2 = .Fields(outputColumnName).Value
.MoveNext 'move to next record
.Find filterString, 0, adSearchForward, adBookmarkCurrent
Else
'multiple record found
Debug.Print "Multiple records found for the filter" & vbNewLine & "WHERE " & filterString
GetRecord2 = False
Exit Function
End If
Loop
End With
If GetRecord2 = False Then 'No result
Debug.Print "No output for the filter" & vbNewLine & "WHERE " & filterString
End If
End Function