Question about code example (1 Viewer)

kirkm

Registered User.
Local time
Tomorrow, 10:26
Joined
Oct 30, 2008
Messages
1,257
I'm way out of my depth here, this is code from Google that claims to search an Access Listbox for a particular string and return the list index.

Code:
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long

Function ListboxFindString(strSearchString As String, lHwndListbox As Long) As Long
Const LB_FINDSTRING = &H18F
ListboxFindString = SendMessage(lHwndListbox, LB_FINDSTRING, -1, ByVal strSearchString)
End Function

Sub dodo()
    Debug.Print ListboxFindString("4", Me.ListBox1.hWnd)
End Sub
It doesn't work because Me.ListBox1.hWnd is method or data member not found.
But would it work that that is known or found? And if yes, can the function be told to look in a particular column?
Thanks.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 15:26
Joined
Oct 29, 2018
Messages
21,447
Hi. Are you sure that's VBA and not VB?
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:26
Joined
May 7, 2009
Messages
19,227
it doesn't work, I supposed.
why not create a udf without API:
Code:
Public Function FindInCboList( _
                                    ByRef List As Object, _
                                    ByVal FindWhat As String, _
                                    Optional ByVal AtColumn As Integer = -1) As Integer
' arnelgp
'
' Note: AtColumn is 1 base
'
' Return is Zero based (consistent with combo/list listindex)
'
    Dim col_count As Byte
    Dim i As Byte, j As Byte, num_elem As Integer
    Dim bolFound As Boolean
    FindInCboList = -1
    col_count = List.ColumnCount
    num_elem = List.ListCount
    'check if AtColumn is valid
    If AtColumn = 0 Or AtColumn > col_count Then
        Exit Function
    End If
    For i = 1 To num_elem
        For j = 1 To col_count
            If List.Column((j - 1), (i - 1)) = FindWhat Then
                If (AtColumn = -1) Or (j = AtColumn) Then
                    bolFound = True
                    Exit For
                End If
            End If
        Next
        If bolFound Then
            Exit For
        End If
    Next
    If bolFound Then
        FindInCboList = i - 1
    End If
End Function
 
Last edited:

kirkm

Registered User.
Local time
Tomorrow, 10:26
Joined
Oct 30, 2008
Messages
1,257
Many thanks Arnelgp, that'll do it, but I was curious about API and hWnd as they're foreign to me and code is smaller.
But if it doesn't work in Access, so be it.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:26
Joined
May 7, 2009
Messages
19,227
I also have same code, unfortunately id doesNT work!
Code:
Private Const CB_FINDSTRING = &H14C
Private Const CB_ERR = (-1)
Private Const CB_SHOWDROPDOWN = &H14F

#If VBA7 Then
Private Declare PtrSafe Function SendMessage Lib "user32" Alias _
                                "SendMessageA" ( _
                                ByVal hwnd As LongPtr, _
                                ByVal wMsg As Long, _
                                ByVal wParam As LongPtr, _
                                lParam As Any) As LongPtr
Private Declare PtrSafe Function apiGetFocus Lib "user32" Alias "GetFocus" () As LongPtr

#Else
Declare Function SendMessage Lib "user32" Alias _
                                 "SendMessageA" _
                                 (ByVal hwnd As Long, _
                                  ByVal wMsg As Long, _
                                  ByVal wParam As Long, _
                                  lParam As Any) As Long
Private Declare Function apiGetFocus Lib "user32" Alias "GetFocus" () As Long

#End If

'* cboCurrent can be a Listbox or a Combobox
Public Function cboFindList(ByRef cboCurrent As Access.Control, ByVal FindChr As String)
#If VBA7 Then
   Dim ICB As LongPtr
   Dim hwnd As LongPtr
#Else
   Dim ICB As Long
   Dim hwnd As Long
#End If
   Dim sFindString As String
 
   On Error GoTo ErrTrap
   sFindString = UCase(FindChr)
   cboCurrent.SetFocus
   hwnd = apiGetFocus()
   ICB = SendMessage(hwnd, CB_FINDSTRING, -1, ByVal sFindString)
   If ICB <> CB_ERR Then
      cboCurrent.ListIndex = CLng(ICB)
      'cboCurrent.SelStart = Len(sFindString)
      'cboCurrent.SelLength = Len(cboCurrent.Text) - cboCurrent.SelStart
        Debug.Print cboCurrent.ListIndex
      'cboFindList = 0
   End If

ExitFunc:
   Exit Function
 
ErrTrap:
   MsgBox Err.Number & "-" & Err.Description
   Err.Clear
   Resume ExitFunc
End Function
 
Last edited:

kirkm

Registered User.
Local time
Tomorrow, 10:26
Joined
Oct 30, 2008
Messages
1,257
I get error on
hwnd = apiGetFocus()
 

Users who are viewing this thread

Top Bottom