FillData

Public Sub m_NotInList(ctrl As Control, strFieldName As String, strTable As String)
    On Error Goto HandleError
    Dim aSqlAs String
    Dim aDB As Database
    Dim aRS As Recordset
    Dim strValueAs String
    Dim TitleAs String
    Dim Msg As String
    Dim Response
    Dim Style
    Const gstrDatabase = "\Database\Oct2000.MDB"'/ Database Name.
    Const gstrAccessPassword = "passme" '/ Database Password.
    Const sConnect = ";pwd=" & gstrAccessPassword'/ Connect String.
    strValue = ctrl
    aSql = "SELECT " & "[" & strFieldName & "]" & _
        " FROM " & "[" & strTable & "]" & " WHERE " & _
        "[" & strFieldName & "]" & "= '" & strValue & "'"
    Set aDB = OpenDatabase("" & App.Path & gstrDatabase & _
        "", False, False, sConnect)
    Set aRS = aDB.OpenRecordset(aSql, dbOpenDynaset)
    aRS.MoveFirst
    aRS.Close
    Set aDB = Nothing
    '/ Value is in the Table so continue
    Exit Sub
    HandleError:
    Title = "Not In list"
    Msg = "Do you want To add a new value named:"
    Msg = Msg & vbCr & strValue
    Style = vbYesNo + vbQuestion + vbDefaultButton1 ' Define buttons.
    Response = MsgBox(Msg, Style, Title)
    If Response = vbYes Then
        aRS.AddNew
        aRS("" & strFieldName & "") = strValue
        aRS.Update
        '/ ReLoad the Combo and then reselect th
        '     e new value.
        'm_FillLookupCombo ctrl, strFieldName, s
        '     trTable
        ctrl = strValue
        ctrl.SetFocus
        Exit Sub
    End If
    Beep
    MsgBox "Select a Value from the list.", vbInformation, App.Title
    ctrl.ListIndex = 0
    ctrl.SetFocus
    aRS.Close
    Set aDB = Nothing
    Exit Sub
End Sub

Public Sub m_NotInList(ctrl As Control, strFieldName As String, strTable As String)
On Error Goto HandleError
Dim aSqlAs String
Dim aDB As Database
Dim aRS As Recordset
Dim strValueAs String
Dim TitleAs String
Dim Msg As String
Dim Response
Dim Style
Const gstrDatabase = "\Database\Oct2000.MDB"'/ Database Name.
Const gstrAccessPassword = "passme" '/ Database Password.
Const sConnect = ";pwd=" & gstrAccessPassword'/ Connect String.
strValue = ctrl
aSql = "SELECT " & "[" & strFieldName & "]" & _
" FROM " & "[" & strTable & "]" & " WHERE " & _
"[" & strFieldName & "]" & "= '" & strValue & "'"
Set aDB = OpenDatabase("" & App.Path & gstrDatabase & _
"", False, False, sConnect)
Set aRS = aDB.OpenRecordset(aSql, dbOpenDynaset)
aRS.MoveFirst
aRS.Close
Set aDB = Nothing
'/ Value is in the Table so continue

Exit Sub
HandleError:
Title = "Not In list"
Msg = "Do you want To add a new value named:"
Msg = Msg & vbCr & strValue
Style = vbYesNo + vbQuestion + vbDefaultButton1 ' Define buttons.
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
aRS.AddNew
aRS("" & strFieldName & "") = strValue
aRS.Update
'/ ReLoad the Combo and then reselect th

' e new value.

'm_FillLookupCombo ctrl, strFieldName, s

' trTable

ctrl = strValue
ctrl.SetFocus
Exit Sub
End If
Beep
MsgBox "Select a Value from the list.", vbInformation, App.Title
ctrl.ListIndex = 0
ctrl.SetFocus
aRS.Close
Set aDB = Nothing
Exit Sub
End Sub