Jugulator
8/12/2018 - 11:16 AM

Get Record

2 alternatives

  • with 'Find' method
  • with 'Filter' method
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