Database & SQL Stuff

Load ComboBox, ListBox from Database Table
Shows text property of ListBox in ToolTip

Got a useful snippet you'd like to share? Submit it here.

'------------------------------------------------------
'Author:Chris O'Leary  
'Posted:5/26/98
'coleary@agri.ns.ca                                      
'
'Generic Sub to fill  comboboxes, listboxes etc...
'usage: loadbox cboBoxName, "dbTableName", "dbIDField", 
'"dbDescriptionField" 
'Where: cboBoxName is the combo/listbox you want to populate, 
'dbTableName is the database table where you want to populate 
'from, dbIDField is the unique Id number for the fields (ie: 
'Customer_ID) and dbDescriptionField is a text field (ie: Customer_Name)
'------------------------------------------------------

Public Sub LoadBox(cboBox As Object, strTB, IDField, descField As
String)

   On Error GoTo Errors
   
   Dim rs As Recordset 'Declare a recordset
   Dim sql As String   'Declare a string to hold the SQL statement

   cboBox.Clear 
   'Clear the combobox in question, in case it isn't 
   sql = "" 
   'Clear SQL in case there is another var named SQL somewhere
   'Setup SQL to select fields based on the values passed to the function
   sql = "SELECT " & IDField & ", " & descField & " FROM " & strTB
   'Open the recordset with the data returned by the SQL statement
   Set rs = db.OpenRecordset(sql, dbOpenForwardOnly)
   
   With rs
      
      Do Until .EOF 'Loop until the End of the recordset
         
         'Add the items, and thier corresponding ID's
         cboBox.AddItem rs(descField)
         cboBox.ItemData(cboBox.NewIndex) = rs(IDField)
         .MoveNext
      
      Loop
      
      .Close
      
      Debug.Print cboBox.Name & " was populated"
      
   End With '(rs)
   
   Set rs = Nothing 'Release the variable

   Exit Sub

Errors: 'Error handler
  
If Err.Number <> 0 Then

   MsgBox ("Error #: " & str(Err.Number) & Err.Description)
   Exit Sub

End If

End Sub

'------------------------------------------------------
'Author:Chris O'Leary  
'Posted:5/26/98
'coleary@agri.ns.ca                                      
'
'Shows the text property of a listbox in the tooltip property, 
'when the mouse hovers over the listbox for a second. Relies 
'on the SendMessage API, declared in the API_Routines file.
'------------------------------------------------------

Public Function ShowListTTip(Button As Integer, Shift As Integer, X As
Single, Y As Single, ListBox As ListBox) As String

    ' Show tool tip message
    
    Dim lXPoint As Long
    Dim lYPoint As Long
    Dim lIndex As Long
    '
    If Button = 0 Then ' No button was pressed
    
        'Get the x/y position of the mouse on the screen.
        'in "TwipsPerPixel" (X and Y)
        lXPoint = CLng(X / Screen.TwipsPerPixelX)
        lYPoint = CLng(Y / Screen.TwipsPerPixelY)
        '
        With ListBox
        
           ' find which listbox item the mouse is hovering over.
           lIndex = SendMessage(.hWnd, LB_ITEMFROMPOINT, 0, ByVal ((lYPoint * 65536) + lXPoint))
           
           ' show the tooltip or clear last one, make sure the index is
           'greater than or equal to 0 and not greater than the listcount
            If (lIndex >= 0) And (lIndex <= .ListCount) Then .ToolTipText=".List(lIndex)" 'Return the text=".list(lIndex)" Else .ToolTipText 'Return nothing
            
            End If
            
        End With '(ListBox)
        
    End If '(button=0)
  
End Function