Does anybody have any functional examples of using the ADO DataCombo & or
DataComboBox controls to do lookups based on a value selected & resync the
other txtbox controls on the same form with the matching records for the
value selected in the "ADO" DataCombo & or DataComboBox....
this does not appear to work the same as the standard DAO ComboBox.
Please reply to me directly and to the list...
thanks...
Patrick

the following is my form code for this VB6.0 project.
this code is fully functional I only want to replace the DAO combobox with a
ADO combobox
and the applicable differences in code...

Option Explicit
'Patrick Kenney
'VB6.0Sp3 or later; with the following
'Project References set:
'1. Visual Basic for applications
'2. Visual Basic Runtime Objects & Procedures
'3. Ole Automation
'4. Microsoft Activex Data Objects 2.0 Library
'5. Microsoft Data Binding Collection
'6. Microsoft Data Environment Instance 1.0

Dim db As ADODB.Connection
Dim WithEvents adoPrimaryRS As ADODB.Recordset
Dim bEditMode As Boolean
Dim bChanged As Boolean
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean

Private Sub adoPrimaryRS_WillMove(ByVal adReason As ADODB.EventReasonEnum,
adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo adoPrimaryRS_WillMove_Err

    bEditMode = False

        If bChanged Then
            DoUpdate
        End If

adoPrimaryRS_WillMove_Err_Exit:
    Exit Sub

adoPrimaryRS_WillMove_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub
'I want to Replace this with ADO DataCombo or ADO DataComboBox
'This is the only DAO control on this form
Private Sub cboList_Click()
On Error GoTo cboList_Err

    adoPrimaryRS.Requery
    adoPrimaryRS.Find "SeqId = " & cboList.ItemData(cboList.ListIndex)

cboList_Exit:
    Exit Sub

cboList_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdSave_Click()
On Error GoTo cmdSave_Err

    DoInsert
    cmdSave.Visible = False

        If adoPrimaryRS.State <> 0 Then
            adoPrimaryRS.Close
        End If

    adoPrimaryRS.Open "Select
Date,Brand,Description,Firm,LookupField,Product,SeqId,TimeStamp,Type,UPC,Ver
sion from tblFreemanLookup Order by SeqId"

cmdSave_Exit:
    Exit Sub

cmdSave_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub Form_Load()
On Error GoTo frmGstMain_Err

'Dim db As Connection
    Set db = New Connection
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data
Source=C:\Patrick\Development\Access Projects\gstProject\Graphics
Specification.mdb;"

    Set adoPrimaryRS = New Recordset
    adoPrimaryRS.Open "Select
Date,Brand,Description,Firm,LookupField,Product,SeqId,TimeStamp,Type,UPC,Ver
sion from tblFreemanLookup Order by SeqId", db, adOpenStatic,
adLockOptimistic

        Do Until adoPrimaryRS.EOF
            cboList.AddItem adoPrimaryRS!LookupField
            cboList.ItemData(cboList.NewIndex) = adoPrimaryRS!SeqId
            adoPrimaryRS.MoveNext
        Loop

    adoPrimaryRS.MoveFirst
    cboList = txtData(0)

    mbDataChanged = False

frmGstMain_Exit:
Exit Sub

frmGstMain_Err:
MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Form_KeyDown_Err

    If mbEditFlag Or mbAddNewFlag Then Exit Sub

    Select Case KeyCode

        Case vbKeyEscape
          cmdClose_Click
        Case vbKeyEnd
          cmdLast_Click
        Case vbKeyHome
          cmdFirst_Click
        Case vbKeyUp, vbKeyPageUp
            If Shift = vbCtrlMask Then
                cmdFirst_Click
            Else
                cmdPrevious_Click
            End If
        Case vbKeyDown, vbKeyPageDown
            If Shift = vbCtrlMask Then
                cmdLast_Click
            Else
                cmdNext_Click
            End If
    End Select

Form_KeyDown_Exit:
    Exit Sub

Form_KeyDown_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub Form_Terminate()
On Error GoTo Form_Terminate_Err

    'Make sure that db connection is closed no matter
    'what; to release resources
    If db.State <> 0 Then
        db.Close
    End If
    'Make sure that ADO RecordSet variable is released;
    'to free resources
    Set adoPrimaryRS = Nothing

Form_Terminate_Exit:
    Exit Sub

Form_Terminate_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Form_Unload_Err

  Screen.MousePointer = vbDefault

Form_Unload_Exit:
    Exit Sub

Form_Unload_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As
ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As
ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo adoPrimaryRS_MoveComplete_Err

    lblStatus.Caption = CStr(adoPrimaryRS.AbsolutePosition)
        If Not adoPrimaryRS.EOF Then
            PopData
        End If
    bEditMode = True
    bChanged = False

adoPrimaryRS_MoveComplete_Exit:
    Exit Sub

adoPrimaryRS_MoveComplete_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As
ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As
ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error GoTo adoPrimaryRS_WillChangeRecord_Err

    Dim bCancel As Boolean

        Select Case adReason

            Case adRsnAddNew
            Case adRsnClose
            Case adRsnDelete
            Case adRsnFirstChange
            Case adRsnMove
            Case adRsnRequery
            Case adRsnResynch
            Case adRsnUndoAddNew
            Case adRsnUndoDelete
            Case adRsnUndoUpdate
            Case adRsnUpdate

        End Select

    If bCancel Then adStatus = adStatusCancel

adoPrimaryRS_WillChangeRecord_Exit:
    Exit Sub

adoPrimaryRS_WillChangeRecord_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdAdd_Click()
On Error GoTo AddErr

'  With adoPrimaryRS
'    If Not (.BOF And .EOF) Then
'      mvBookMark = .Bookmark
'    End If
'    .AddNew
'    lblRecord.Caption = "Add record"
'    mbAddNewFlag = True
'    SetButtons False
'  End With
    Dim txtAdd As TextBox
        For Each txtAdd In txtData
            txtAdd.Text = ""
        Next

    cmdSave.Visible = True

Add_Exit:
    Exit Sub

AddErr:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdDelete_Click()
On Error GoTo DeleteErr

    With adoPrimaryRS
        .Delete
        .MoveNext
            If .EOF Then .MoveLast
    End With

Delete_Exit:
    Exit Sub

DeleteErr:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdRefresh_Click()
On Error GoTo RefreshErr

    adoPrimaryRS.Requery

        If Not cboList = txtData(0) Then
            adoPrimaryRS.Find "SeqId = " &
cboList.ItemData(cboList.ListIndex)
        End If

RefreshErr_Exit:
    Exit Sub

RefreshErr:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdEdit_Click()
On Error GoTo EditErr

    lblRecord.Caption = "Edit record"
    mbEditFlag = True
    SetButtons False

EditErr_Exit:
  Exit Sub

EditErr:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub
Private Sub cmdCancel_Click()
On Error Resume Next

    SetButtons True
    mbEditFlag = False
    mbAddNewFlag = False
    adoPrimaryRS.CancelUpdate

        If mvBookMark > 0 Then
            adoPrimaryRS.Bookmark = mvBookMark
        Else
            adoPrimaryRS.MoveFirst
        End If

    mbDataChanged = False

End Sub

Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr

    adoPrimaryRS.UpdateBatch adAffectAll

        If mbAddNewFlag Then
            adoPrimaryRS.MoveLast 'move to the new record
        End If

    mbEditFlag = False
    mbAddNewFlag = False
    SetButtons True
    mbDataChanged = False

UpdateErr_Exit:
    Exit Sub

UpdateErr:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdClose_Click()
On Error GoTo cmdClose_Err

    'Make sure that db connection is closed no matter
    'what; to release resources
    If db.State <> 0 Then
        db.Close
    End If
    'Make sure that ADO RecordSet variable is released;
    'to free resources
    Set adoPrimaryRS = Nothing

    Unload Me

cmdClose_Exit:
    Exit Sub

cmdClose_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdFirst_Click()
On Error GoTo GoFirstError

    adoPrimaryRS.MoveFirst
    mbDataChanged = False
    cboList = txtData(0)

GoFirstError_Exit:
    Exit Sub

GoFirstError:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdLast_Click()
On Error GoTo GoLastError

    adoPrimaryRS.MoveLast
    mbDataChanged = False
    cboList = txtData(0)

GoLastError_Exit:
  Exit Sub

GoLastError:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdNext_Click()
On Error GoTo GoNextError

    adoPrimaryRS.MoveNext

'    If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
'        If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
'            Beep
            'moved off the end so go back
'            adoPrimaryRS.MoveLast
            cboList = txtData(0)
'            adoPrimaryRS.Requery

'    End If

    'show the current record
    mbDataChanged = False

GoNextError_Exit:
    Exit Sub
GoNextError:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub cmdPrevious_Click()
  On Error GoTo GoPrevError

'  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
'    If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
'        Beep
        adoPrimaryRS.MoveFirst
        cboList = txtData(0)

'    End If

  mbDataChanged = False

GoPrevError_Exit:
    Exit Sub

GoPrevError:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub SetButtons(bVal As Boolean)
On Error GoTo SetButtons_Err

    cmdAdd.Visible = bVal
    cmdEdit.Visible = bVal
    cmdUpdate.Visible = Not bVal
    cmdCancel.Visible = Not bVal
    cmdDelete.Visible = bVal
    cmdClose.Visible = bVal
    cmdRefresh.Visible = bVal
    cmdNext.Enabled = bVal
    cmdFirst.Enabled = bVal
    cmdLast.Enabled = bVal
    cmdPrevious.Enabled = bVal

SetButtons_Err_Exit:
    Exit Sub

SetButtons_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub PopData()
'On Error Resume Next
On Error GoTo PopData_Err

    Dim vItem As TextBox
    For Each vItem In txtData
        vItem.Text = adoPrimaryRS(vItem.Tag) & " "
    Next

PopData_Err_Exit:
    Exit Sub

PopData_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub DoInsert()
On Error GoTo DoInsert_Err

   Dim vItem As TextBox
   Dim ssql As String
   Dim sFlds As String
   Dim sVals As String
   ssql = "INSERT INTO tblFREEMANLOOKUP ("

    For Each vItem In txtData

        If Len(Trim(vItem.Text)) Then
            sFlds = sFlds & vItem.Tag & ", "
    Select Case vItem.Index
        Case 0, 2, 6, 7, 8, 10  'Text
            sVals = "'" & sVals & vItem.Text & "', "
        Case 3, 4, 5, 9  'Numbers
            sVals = sVals & vItem.Text & ", "
        Case 1   'Dates
            sVals = "#" & sVals & vItem.Text & "#, "
     End Select
        End If
   Next
    sVals = Left$(sVals, Len(sVals) - 2)
    sFlds = Left$(sFlds, Len(sFlds) - 2)
    ssql = ssql & sFlds & ") values (" & sVals & ")"
    '   MsgBox ssql
    Dim lcount As Long
    adoPrimaryRS.MoveLast

        If Not adoPrimaryRS.State Then
            adoPrimaryRS.Close
        End If

    adoPrimaryRS.Open ssql
    adoPrimaryRS.Open "Select Max(SeqId)as x From tblFreemanLookup"
    lcount = adoPrimaryRS!x + 1

    If Not adoPrimaryRS.State Then
        adoPrimaryRS.Close
    End If

    adoPrimaryRS.Open "UPDATE tblFreemanLookup SET
tblFreemanLookup.LookupField = ('(' & [tblFreemanLookup]![SeqId] & ')' & ' '
& [tblFreemanLookup]![UPC] & '-' & [tblFreemanLookup]![Version])  where
seqid = " & lcount

DoInsert_Err_Exit:
    Exit Sub

DoInsert_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub DoUpdate()
On Error GoTo DoUpdate_Err

   Dim vItem As TextBox
   Dim ssql As String

   ssql = "UPDATE tblFreemanLookup Set"

   For Each vItem In txtData

    Select Case vItem.Index
        Case 0, 2, 6, 7, 8, 10  'Text
            ssql = ssql & vItem.Tag & " = '" & IIf(Len(Trim(vItem.Text)) =
0, "", vItem.Text) & "', "
        Case 3, 4, 5, 9 'Numbers
            ssql = ssql & vItem.Tag & " = " & IIf(Len(Trim(vItem.Text)) = 0,
"NULL", vItem.Text) & ", "
        Case 1   'Dates
            ssql = ssql & vItem.Tag & " = " & IIf(Len(Trim(vItem.Text)) = 0,
"NULL", "#" & vItem.Text & "#, ")
    End Select

    Next

    ssql = Left$(ssql, Len(ssql) - 1)
    ssql = ssql & " where seqid = " & txtData(9)
    adoPrimaryRS.Open ssql
'    MsgBox ssql

DoUpdate_Err_Exit:
    Exit Sub

DoUpdate_Err:
    MsgBox Err.Number & "," & " " & Err.Description

End Sub

Private Sub txtData_Change(Index As Integer)
On Error GoTo txtData_Change_Err

    If Not bEditMode Then Exit Sub
    bChanged = True

txtData_Change_Err_Exit:
    Exit Sub

txtData_Change_Err:
    MsgBox Err.Number & "," & " " & Err.Number

End Sub