Работаем с DAO 3.6

Private Sub Заполнить(ByVal Параметр As String)
On Error GoTo bay
Dim RS As ADODB.Recordset
Set RS = New ADODB.Recordset
CBO.Clear
    RS.Open 'select * from Таблица where [Имя] Like '%' _ 
  & Параметр & '%'', CON, adOpenStatic
    With RS
        If .BOF And .EOF Then
            GoTo ex
        End If
            Do While RS.EOF = False
                CBO.AddItem .Fields('Имя').Value
            Loop
        End With
ex:
    If Not RS Is Nothing Then
        If RS.State = 1 Then RS.Close
    End If
    Set RS = Nothing
Exit Sub
bay:
    MsgBox Err.Description, vbExclamation, Err.Source
    Set RS = Nothing
End Sub

Public Function ПарЗапрос(cn As ADODB.Connection, Источник As String, ИмяПар As String, mVar As Variant) As ADODB.Recordset
Dim Com As ADODB.Command
Dim rs As ADODB.Recordset
Dim PRM As ADODB.Parameter
On Error GoTo bay
    Set Com = New ADODB.Command
    Set Com.ActiveConnection = cn
    Com.CommandText = Источник
    Com.CommandType = adCmdStoredProc
    Set PRM = Com.CreateParameter(ИмяПар, adVariant, adParamInput)
    PRM.Value = mVar
    Com.Parameters.Append PRM
    Set ПарЗапрос = Com.Execute
    Set Com = Nothing
    Set PRM = Nothing
Exit Function
bay:
    MsgBox Err.Description, vbExclamation
End Function