Source code for Issue Number 18

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into any module (this is the desired way) or form. To do this, open up your project and insert a new Module. Change the name of the module to basDatabase and paste this code into the module.

'----------------------------------------------------------------------
'
'   Module Name:    basDatabase
'   Written By:     C&D Programming Corp.
'   Create Date:    12/26/97
'   Copyright:      Copyright 1997-98 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'
'   Purpose:        Loads a combo box with information from a database
'                   table.
'
'
'   Example Call:
'       DBLoadCombo(gDBName, "SELECT * FROM TABLE", ComboControl, "Description", "ID")
'
'----------------------------------------------------------------------
Public Sub DBLoadCombo(sDB As String, sSQL As String, cmb As ComboBox, sDisplayField As String, sIDField As String)
    Dim wrk As Workspace
    Dim db As Database
    Dim rs As Recordset

    On Error GoTo Handler       ' enable error handlers

    cmb.Clear                   ' remove all items first.

    ' open the workspace, database (read-only) and a snapshot recordset
    Set wrk = DBEngine.Workspaces(0)
    Set db = wrk.OpenDatabase(sDB, False, True)
    Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)

    ' loop through the record set and add it to the combo box.
    rs.MoveFirst
    While Not rs.EOF
        cmb.AddItem "" & rs.Fields(sDisplayField).Value
        If sIDField <> "" Then
            cmb.ItemData(Combo.NewIndex) = rs.Fields(sIDField).Value
        End If
        rs.MoveNext
    Wend

    ' clean up database objects
    Set rs = Nothing
    Set db = Nothing
    Set wrk = Nothing
    Exit Sub

Handler:
    Err.Raise Err.Number, "DBLoadCombo", Err.Description
End Sub