Recently I had some post discussions guys about searching
in a DataCombo box. I found a class module on planet
source code that works but has several errors that I would
like to solve.
I need to know how to determine the cursor's location when
a user is keying data into the text portion of the
DataCombo so that I can fix two of the bugs. The errors
occur in the cases Case vbKeyBack and Case Is >= vbKeySpace
in the code below.
The vbKeyBack bug is that if the user hits the back key and
deletes a character, that character is not removed from the
static variable Search. The Case Is >= vbKeySpace
bug is that if the user is keying in data and moves the
cursor back with the arrow key or the mouse and then hits
another key, the character is assigned to the variable
Search at the end of the string and not in the proper place.
This is the code of the KeyPress event of a variable
declared as a DataCombo in the class module. It is not the
exact code of the original, as I have made some changes.
Code:Private Sub MDS_DCombo_KeyPress(KeyAscii As Integer)
'On Error GoTo MDS_DCombo_KeyPress_Err
Static Search As String
Dim Index As Long
Dim DoSearch As Boolean
'[ANDREW] originally the following two declarations were after the line of
'code "If (DoSearch = True) And Len(Search) > 0 Then"
'I moved them here because I like to see all declarations at the beginning
'of a subroutine
Dim strCriteria As String
Dim BookMk
'[ANDREW] have to leave the subroutine if the recordset is empty because the
'operations in the following code cannot be performed on an empty recordset
If MDS_RST.RecordCount = 0 Then Exit Sub
If MDS_STOP Then Search = ""
MDS_STOP = False
Select Case KeyAscii
Case vbKeyBack
Search = MDS_DCombo
Exit Sub
'[ANDREW] I never could figure out the purpose of including the case
'vbKeyBack. In my program the following code cause too many errors, so I
'just commented it out and added the Exit Sub statment above
' If Len(Search) Then
' Search = Left(Search, Len(Search) - 1)
'
' DoSearch = True
' End If
' KeyAscii = 0
Case vbKeyReturn, vbKeyTab
With MDS_DCombo
.SelStart = Len(.Text)
.SelLength = 0
End With
DoSearch = False
KeyAscii = vbKeyReturn
Case Is >= vbKeySpace
Search = Search & UCase(Chr(KeyAscii))
DoSearch = True
Debug.Print Search
Case Else
DoSearch = False
'[ANDREW] I added the Case Else because it is good form to include it in
'Select Case structures in case of bizarre windows errors
End Select
If (DoSearch = True) And Len(Search) > 0 Then
strCriteria = MDS_FIELD.Name & " like '" & Search & "*'"
With MDS_RST
'Debug.Print Search
BookMk = .Bookmark '[ANDREW] refreshing MDS_RST makes this line generate the error "operation requested is not supported by the provider"
.Find strCriteria, , , 1
If .EOF Then
'There is no match
.Bookmark = BookMk
'Search = Left(Search, Len(Search) - 1)
If Len(Search) = 0 Then MDS_DCombo.Text = ""
Exit Sub
'[ANDREW] I had to add the preceding Exit Sub statement because after
'I changed the passed recordset from ADODC controls to an ADO recordset,
'this routine took on a mind of its own and started to block characte
'entries if no match was found
Else
MDS_DCombo.Text = MDS_FIELD
End If
End With
Call Highlight(Len(Search))
KeyAscii = 0
Else
If Len(Search) Then
KeyAscii = KeyAscii
Else
MDS_DCombo.Text = ""
End If
End If
MDS_DCombo_KeyPress_Exit:
Exit Sub
MDS_DCombo_KeyPress_Err:
'[ANDREW] I added the following Select Case series
Select Case Err.Number
Case 3001 '[ANDREW] a Type Mismatch error occurs if user hits a * as the first key
If Right(strCriteria, 4) = "'**'" Then Exit Sub
Case Else '[ANDREW] original error code below
MsgBox Prompt:="Unexpected Error - " & Err.Number & " " & Err.Description, _
Buttons:=vbOKOnly + vbCritical, _
Title:="clsDataComboSearch.MDS_DCombo_KeyPress"
End Select
End Sub
