Private Const HC_ACTION = 0
Private hHook As Long
Private Const HCBT_ACTIVATE = 5
Public Const WH_CBT = 5
Public Const EM_SETPASSWORDCHAR = &HCC
Private Declare PtrSafe 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 PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long

Public Function vbInputBox(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Single, Optional Ypos As Single, Optional Helpfile As String, Optional Context As Long) As String
    hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, 0)
    vbInputBox = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
End Function

Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hwndEditControl As Long
    If lMsg = HCBT_ACTIVATE Then
        hwndEditControl = FindWindowEx(wParam, 0, "Edit", "")
        If hwndEditControl Then SendMessage hwndEditControl, EM_SETPASSWORDCHAR, Asc("*"), 0
        UnhookWindowsHookEx hHook
    End If
    CBTProc = 0
End Function

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim RetVal
    Dim strClassName As String, lngBuffer As Long
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
    strClassName = String$(256, " ")
    lngBuffer = 255
    If lngCode = HCBT_ACTIVATE Then
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
    End If
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function

Public Function InputBoxDK(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Long, Optional Ypos As Long, Optional Helpfile As String, Optional Context As Long) As String
    Dim lngModHwnd As Long, lngThreadID As Long
    On Error GoTo ExitProperly
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
    If Xpos Then
        InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
    Else
        InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context)
    End If
ExitProperly: UnhookWindowsHookEx hHook
End Function

    Dim sSQL As String
    Set FConn = New ADODB.Connection
    Set pFilter = New ADODB.Recordset
    pFilter.CursorLocation = adUseClient
    FConn.Open "DRIVER={MySQL ODBC 5.1 Driver}; SERVER=localhost; USER=root; PASSWORD=MyPassword; Option=3"
    sSQL = "SELECT * FROM keep_3.keep"
    pFilter.Open sSQL, FConn.ConnectionString, adOpenKeyset, adLockOptimistic
    If pFilter.RecordCount > 0 Then
    ...

pFilter.Open sSQL, FConn.ConnectionString, adOpenKeyset, adLockOptimistic

"SELECT * " & _
"FROM (SELECT (IF(Город='Кропивницький','',Город & ', ')  & Улица & ', ' & IF(Дом>'', Дом,'') & IF(Буква='','','-' & Буква) & IF(Корп>0,' корп.' & Корп,'') & IF(Кв>0,' кв.' & Кв,'')) AS AD From jornal.adres) AS t1 " & _
"WHERE AD LIKE '%" & Me.TB3.Text & "%'"

Sub Counter()
    Dim sSQL As String
    Set pFilter = New ADODB.Recordset
    Set FConn = New ADODB.Connection
    FConn.Open "DRIVER={MySQL ODBC 5.1 Driver}; SERVER=Server_Name; USER=root; PASSWORD=My_Password; Option=3"

    '======================== ВАРИАНТ 1 ======================================
    sSQL = "SELECT COUNT(*) FROM catalog.city WHERE Street = 'вул. Леніна'"
    pFilter.Open sSQL, FConn, adOpenKeyset, adLockOptimistic '
    MsgBox pFilter.Fields(0).Value ' получаю только число строк без возможности получения данных

    '======================== ВАРИАНТ 2 ======================================
    sSQL = "SELECT City FROM catalog.city WHERE Street = 'вул. Леніна'"
    pFilter.Open sSQL, FConn, adOpenKeyset, adLockOptimistic '
    MsgBox pFilter.RecordCount 'Получаю -1
End Sub

Dim FConn As ADODB.Connection
Private Sub ConnectDB()
    Set FConn = New ADODB.Connection
    FConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
    "SERVER=localhost;" & _
    "DATABASE=forum;" & _
    "USER=root;" & _
    "PASSWORD=;" & _
    "Option=3"
    If FConn.State = adStateOpen Then
        MsgBox "Connected... =)"
    Else
        MsgBox "Can not connect... =("
    End If
End Sub

Dim FConn As New ADODB.Connection, pFilter As New ADODB.Recordset, sSQL As String
    sPath = ThisWorkbook.Path & "\БД.mdb"
    FConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPath & ";"
    FConn.Execute ("INSERT INTO Данные ([Наименование]) VALUES ('" & Me.ComboBox1 & "')")

MsgBox Application.CommandBars.ActionControl.Caption