I haven't time to edit this code but here you go....will populate all comboboxes on form...extend matching as you type..match to SQL records and add new record if unmatched
'*******Form
Private Sub cboAuthor_Change()
ExtendedMatching Form1.cboAuthor
End Sub
Private Sub cboAuthor_KeyDown(KeyCode As Integer, Shift As Integer)
ExtendedMatchKeyDown Form1.cboAuthor, KeyCode, Shift
End Sub
Private Sub cboAuthor_LostFocus()
MatchCreateComboData Form1.cboAuthor, "spAddAuthor", ConnStr
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'Form Keypreview set to true
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{Tab}"
End If
End Sub
Private Sub Form_Load()
PopulateSimpleCombo Form1.cboAuthor, "spAuthor", ConnStr
End Sub
'******* Procedure
Option Explicit
Dim Back As Boolean
Global Const ConnStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=False;Initial " & _
"Catalog=Blah Blah;Data Source=Blah Blah"
'******** Populates all combo boxes on form with results of stored procedure ******
'******** Assumptions: that Recordset 0 field = ItemData, 1 field = Text to be _
********* displayed *******
'********
'******** Passed: Form name, Stored Procedure name and connection string ******************
Public Sub PopulateSimpleCombo(objCtl As ComboBox, StorProc As String, ADOConnstr As String)
Dim adoconn As New ADODB.Connection
Dim ADOCmd As New ADODB.Command
Dim Param As New ADODB.Parameter
Dim adorst As New ADODB.Recordset
Dim rstFieldID As String
Dim rstField As String
adoconn.Open ADOConnstr
'For Each Objctl In frmName
'StorProc = Mid(objCtl.Name, 4, Len(objCtl.Name) - 3)
'If TypeName(Objctl) = "ComboBox" Then
ADOCmd.CommandText = StorProc
ADOCmd.CommandType = adCmdStoredProc
ADOCmd.ActiveConnection = adoconn
Set adorst = ADOCmd.Execute
With adorst
Do Until adorst.EOF
objCtl.AddItem (adorst(1))
objCtl.ItemData(objCtl.NewIndex) = adorst(0)
adorst.MoveNext
Loop
.Close
End With
'End If
'Next
End Sub
'****** Extended Matching *****
Public Sub ExtendedMatchKeyDown(objCombo As ComboBox, iKeyCode As Integer, iShift As Integer)
'shouldn't respond to BackSpace or Delete.
If iKeyCode = 8 Or iKeyCode = 46 Then 'KeyCode 8 is backspace...46 is delete
If objCombo.Text <> "" Then
Back = True
End If
End If
End Sub
Public Sub ExtendedMatching(objCombo As ComboBox)
'keeps backspace from messing up program
If Back = True Or objCombo.Text = "" Then
Back = False
Exit Sub
End If
Dim i As Long
Dim nSel As Long
For i = 0 To objCombo.ListCount - 1
If InStr(1, objCombo.List(i), objCombo.Text, _
vbTextCompare) = 1 Then
nSel = objCombo.SelStart
objCombo.Text = objCombo.List(i)
objCombo.SelStart = nSel
objCombo.SelLength = Len(objCombo.Text) - nSel
Exit For
End If
Next
End Sub
'*****Match(or not) Text entered to listitem in Combo box avoid retrieving -1 as the listitem *****
Public Sub MatchCreateComboData(objCombo As ComboBox, Optional spAddRecord As String, Optional ADOConnstr As String)
Dim adoconn As New ADODB.Connection
Dim ADOCmd As New ADODB.Command
Dim Param As New ADODB.Parameter
Dim i As Integer
If objCombo = "" Then Exit Sub
' Itterate through Combobox items to match entry to list item
For i = 0 To objCombo.ListCount - 1
If LCase(objCombo.List(i)) = LCase(objCombo.Text) Then
objCombo.ListIndex = i
Exit Sub
End If
Next i
'Naming convention allows
'spAddRecord = "spAdd" & Mid(objCtl.Name, 4, Len(objCtl.Name) - 3)
'Add new record to table if Stored Procedure name has been passed _
else Exit
If spAddRecord = "" Then Exit Sub
adoconn.Open ConnStr
Set ADOCmd.ActiveConnection = adoconn
ADOCmd.CommandText = spAddRecord
ADOCmd.CommandType = adCmdStoredProc
Set Param = ADOCmd.CreateParameter("@Param", adVarChar, adParamInput, 50, 0)
Param.Value = objCombo.Text
ADOCmd.Parameters.Append Param
ADOCmd.Execute
'Add new item and index to Combobox
objCombo.AddItem objCombo.Text
objCombo.ItemData(objCombo.NewIndex) = (objCombo.ListCount + 1)
objCombo.Refresh
'Recursion - to Match new data
MatchCreateComboData objCombo
End Sub
