Function odbcRowSource(fld As control, id As Variant, row As Variant, col As Variant, code As Variant) As Variant
'Copyright (c) 2001 Cedar Cox - Debug.Print GPL_ver_2_or_later()
'Last updated 200104142100
On Error GoTo bombOut
  Static rst() As Recordset, numUses() As Integer   'numUses tracks how many controls are using a rst
  Static lastRow() As Integer, notFirstCall As Boolean
  Static IDbyRowSource As New Collection             'this tracks rst IDs by row source (ie, keySQL)
  Static rowSourcebyID() As String 'see comment in code
  Static IDbyFld As New Collection                   'this tracks rst IDs by fld.Parent.Hwnd & fld.Name (unique control name)
  Dim retVal As Variant
  Dim keySQL As String, keyFound As Boolean, freeRst As Boolean, newRstID As Integer, idLoop As Integer
  
  If code = acLBInitialize Or code = acLBOpen Then
    keySQL = fld.RowSource
    
    'You can adjust the these to suit your needs
    ' .. perhaps create a duplicate function called odbcUniqueRowSource and use option #3
    
    '1. standard keySQL
    'implicit keySQL = keySQL  - don't uncomment this! ;)
    
    '2. add window handle - use this to keep recordset sharing separated by window
    'keySQL = fld.Parent.Hwnd & keySQL
    
    '3. add window handle and control name - use this to disallow recordset sharing
    ' (note: window handle + control name is unique)
    keySQL = fld.Parent.Hwnd & fld.Name & keySQL
  
  ElseIf code = acLBEnd Then
    'keySQL = rst(IDbyFld(fld.Parent.Hwnd & fld.Name)).Name
    'above would have worked, but .Name only returns 256 characters
    '.. this is the reason for rowSourcebyID
    'note: rowSourcebyID already contains ..Hwnd and fld.Name if added above
    keySQL = rowSourcebyID(IDbyFld(fld.Parent.Hwnd & fld.Name))
  End If
  
  Select Case code
    Case acLBInitialize       ' Initialize.
      If Nz(fld.RowSource) = "" Then retVal = False: Exit Function
      
      'look for existing recordset with same SQL as what I want
        On Error Resume Next
        If IDbyRowSource(keySQL) Is Not Null Then keyFound = True
        If Err.Number = 5 Then
          keyFound = False
          Err.Clear
        End If
        On Error GoTo 0
      
      'if key is not found
      If Not keyFound Then
          If notFirstCall Then
            'try to find unused rst, store id in newRstID
            '..this eliminates old unused rst elements and reuses them
            For idLoop = 1 To UBound(numUses)
                If numUses(idLoop) <= 0 Then
                  freeRst = True
                  newRstID = idLoop
                  Exit For
                End If
            Next idLoop
            'if not found then increase array sizes and add new key
            If Not freeRst Then
                newRstID = UBound(rst) + 1
                ReDim Preserve rst(newRstID), numUses(newRstID), lastRow(newRstID), rowSourcebyID(newRstID)
            End If
          Else 'first call
            notFirstCall = True
            ReDim Preserve rst(1), numUses(1), lastRow(1), rowSourcebyID(1)
            newRstID = 1
          End If
          IDbyRowSource.Add newRstID, keySQL
      End If
      
      On Error Resume Next
      Set rst(IDbyRowSource(keySQL)) = odbcConn.OpenRecordset(fld.RowSource, dbOpenSnapshot, dbExecDirect)
      If Err.Source = "DAO.Connection" Then
        ''Uncomment this if you want to display odbc errors
        'MsgBox Mid(DBEngine.Errors(0), InStr(DBEngine.Errors(0), "ERROR:") + 7) & "@@" & fld.RowSource, vbExclamation, "Error!"
        retVal = False
        Err.Clear
        Exit Function
      End If
      On Error GoTo 0
      rowSourcebyID(IDbyRowSource(keySQL)) = keySQL '..this looks silly.  It's for a "reverse" lookup
      lastRow(IDbyRowSource(keySQL)) = 0
      numUses(IDbyRowSource(keySQL)) = numUses(IDbyRowSource(keySQL)) + 1
      ''if you're curious, uncomment the next line to Debug.Print if a recordset is used more than once
      'If numUses(IDbyRowSource(keySQL)) > 1 Then Debug.Print "numUses=" & numUses(IDbyRowSource(keySQL)), rst(IDbyRowSource(keySQL)).Name
      retVal = True
    '-----
    Case acLBOpen           ' Open.
      'track which recordsetid this control uses - to be used when code=acLBEnd
      IDbyFld.Add IDbyRowSource(keySQL), fld.Parent.Hwnd & fld.Name
      'give an id to this control - this in not necessarily unique
      ' this references which recordset to use in future calls
      retVal = IDbyRowSource(keySQL)
    '-----
    Case acLBGetRowCount        ' Get rows.
      retVal = rst(id).RecordCount
      'add one if column heads is set
      If fld.ColumnHeads Then
        retVal = retVal + 1
      End If
    '-----
    Case acLBGetColumnCount   ' Get columns.
      'retVal = fld.ColumnCount
      retVal = rst(id).Fields.count
    '-----
    Case acLBGetColumnWidth   ' Get column width.
      retVal = -1       ' Use default width.
    '-----
    Case acLBGetValue         ' Get the data.
      If rst(id).RecordCount < 0 Then
        Debug.Print "ERROR!! - record count in odbcrowsource"
      Else
        If fld.ColumnHeads And row = 0 Then
          'get field names for header row
          retVal = rst(id).Fields(col).Name
        Else
          'get data for cell - adjust for column heads
          rst(id).Move row - IIf(fld.ColumnHeads, 1, 0) - lastRow(id)
          retVal = rst(id).Fields(col)
          lastRow(id) = row - IIf(fld.ColumnHeads, 1, 0)
        End If
      End If
    '-----
    Case acLBGetFormat
      retVal = -1
    '-----
    Case acLBEnd
      'we have to use IDbyFld to get the id because id is not set properly when case is acLBEnd (Access bug)
      numUses(IDbyFld(fld.Parent.Hwnd & fld.Name)) = numUses(IDbyFld(fld.Parent.Hwnd & fld.Name)) - 1
      
      'if we are the last one using this recordset then close it and remove related collection items
      If numUses(IDbyFld(fld.Parent.Hwnd & fld.Name)) <= 0 Then
        IDbyRowSource.Remove keySQL
        Set rst(IDbyFld(fld.Parent.Hwnd & fld.Name)) = Nothing
      End If
      
      'numUses only tracks recordsets, not IDbyFld.. remove no matter what numUses is
      '(the implicit numUse of a fldid would be 1)
      IDbyFld.Remove fld.Parent.Hwnd & fld.Name
  
  End Select
  
  odbcRowSource = retVal

Exit Function
bombOut:
  If code = acLBGetValue Then odbcRowSource = "ERROR!"
End Function
