Dim rstTemp As Recordset
    Set rstTemp = DB.OpenRecordset("SELECT * FROM *TableName* WHERE *Filed* LIKE '[Г-Т]%'"

    if not (rstTemp.EOF Or rstTemp.BOF) then
        Call rstTemp.MoveFirst

        Do until (rstTemp.EOF Or rstTemp.BOF)
            Call MsgBox(*FiledName*)
            Call rstTemp.MoveNext
        Loop
    end if

Option Explicit

'***************************************************************************************
'*                     Написано: 06.12.2004 (Team HomeWork)                            *
'*                           e-mail: sne_pro@mail.ru                                   *
'***************************************************************************************

Public Enum gbDBColumns
    None = 0
    sName = 1
    sTel = 2
    sAdress = 3
End Enum

Public Type gbDBCard                        ' Составлено по БД
    szNumber    As Long
    szAbonent   As String
    szAdress    As String
End Type

Private Const sNone     As String = "<Неизвестно>"
Private Const sTable    As String = "YAR"

Dim DB As ADODB.Connection

'--------------------------------------------------------------------------------
' Проект     :  prjTel
' Процедура  :  BConnect
' Описание   :  Подключение
' Кем создан :  SNE
' Дата-Время :  06.12.2004-2:27:17
'--------------------------------------------------------------------------------
Public Function DBConnect(ByVal szDataBase As String) As Boolean
    On Error GoTo err

    Set DB = New ADODB.Connection
    B.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0ata Source=" & szDataBase & _
                          ";Persist Security Info=False"

    Call DB.Open
    BConnect = True
Exit Function
err:
    BConnect = False
    Set DB = Nothing
    Call ErrorHandler(err, "BConnect"
End Function

'--------------------------------------------------------------------------------
' Проект     :  prjTel
' Процедура  :  BClose
' Описание   :  Закрытие БД
' Кем создан :  SNE
' Дата-Время :  06.12.2004-2:27:36
'--------------------------------------------------------------------------------
Public Sub DBClose()
    If DB Is Nothing Then Exit Sub

    Call DB.Close
    Set DB = Nothing
End Sub

'--------------------------------------------------------------------------------
' Проект     :  prjTel
' Процедура  :  RecordsCount
' Описание   :  Подсчет кол-ва записей
' Кем создан :  SNE
' Дата-Время :  06.12.2004-2:27:48
'--------------------------------------------------------------------------------
Public Function RecordsCount() As Long
    On Error GoTo err
    Dim rstTemp As ADODB.Recordset

    Set rstTemp = New ADODB.Recordset
    Call rstTemp.Open("SELECT COUNT(NTEL) AS Cnt FROM " & sTable, DB, adOpenForwardOnly, adLockReadOnly)

    RecordsCount = rstTemp!cnt

    On Error Resume Next
    Call rstTemp.Close
    Set rstTemp = Nothing
Exit Function
err:
    Call ErrorHandler(err, "RecordsCount"
End Function

'--------------------------------------------------------------------------------
' Проект     :  prjTel
' Процедура  :  SearchIDs
' Описание   :  Поиск
' Кем создан :  SNE
' Дата-Время :  06.12.2004-2:28:02
'
' Параметры  :  strForSearch    - Строка для поиска
'               wSearch         - Где искать
'               SortingBy       - По чему сортировать
'               iRange          - Возвращаемое значение, кол-во найденных записей
'--------------------------------------------------------------------------------
Public Function SearchIDs(ByRef strForSearch As String, _
                          ByVal wSearch As gbDBColumns, _
                 Optional ByRef SortingBy As gbDBColumns = sName, _
                 Optional ByRef iRange As Long) As Long()
    On Error GoTo err

    Dim strSortF    As String, _
        strField    As String
    Dim rstTemp     As ADODB.Recordset, _
        outArray()  As Long

    Select Case SortingBy
        Case Is = sAdress:  strSortF = "ADR"
        Case Is = sName:    strSortF = "ABON"
        Case Is = sTel:     strSortF = "NTEL"
    End Select
    Select Case wSearch
        Case Is = sAdress:  strField = "ADR"
        Case Is = sName:    strField = "ABON"
        Case Is = sTel:     strField = "NTEL"
    End Select

    Set rstTemp = New ADODB.Recordset
    Call rstTemp.Open("SELECT NTEL FROM " & sTable & " WHERE " & strField & " LIKE '" & strForSearch & "'", _
                      B, adOpenStatic, adLockReadOnly)

    With rstTemp
        If Not .EOF Then
            Call .MoveLast
            ReDim outArray(.RecordCount - vbNull)
            Call .MoveFirst
        End If

        Do Until rstTemp.EOF
            outArray(iRange) = .Fields(0).Value

            iRange = iRange + vbNull
            Call .MoveNext
        Loop
    End With

    SearchIDs = outArray

    On Error Resume Next
    Call rstTemp.Close
    Set rstTemp = Nothing
    Exit Function
err:
    Call ErrorHandler(err, "SearchIDs"
End Function

'--------------------------------------------------------------------------------
' Проект     :  prjTel
' Процедура  :  ResortIDs
' Описание   :  Выборка телефонов (в качестве ID) в каком-то порядке
' Кем создан :  SNE
' Дата-Время :  06.12.2004-2:30:46
'
' Параметры  :  SortingBy   - По какому полю сортировать
'               SortRev     - В обратном порядке ?
'               iRange      - Кол-во найденных записей...
'--------------------------------------------------------------------------------
Public Function ResortIDs(Optional ByRef SortingBy As gbDBColumns = sName, _
                          Optional ByRef SortRev As Boolean = False, _
                          Optional ByRef iRange As Long) As Long()
    On Error GoTo err

    Dim strField    As String
    Dim rstTemp     As ADODB.Recordset, _
        outArray()  As Long

    Select Case SortingBy
        Case Is = sAdress:  strField = "ADR"
        Case Is = sName:    strField = "Abon"
        Case Is = sTel:     strField = "NTEL"
    End Select

    Set rstTemp = New ADODB.Recordset
    Call rstTemp.Open("SELECT NTEL FROM " & sTable & _
                            IIf(SortingBy = 0&, vbNullString, " ORDER BY " & IIf(SortRev, "NOT ", vbNullString) & strField), _
                      B, adOpenForwardOnly, adLockReadOnly)

    ReDim outArray(RecordsCount)
    
    With rstTemp
        If Not .EOF Then Call .MoveFirst
        Do Until .EOF
            outArray(iRange) = .Fields(0).Value

            iRange = iRange + vbNull
            Call .MoveNext
        Loop
    End With

    ResortIDs = outArray

    On Error Resume Next
    Call rstTemp.Close
    Set rstTemp = Nothing
    Exit Function
err:
    Call ErrorHandler(err, "ResortIDs"
End Function

'--------------------------------------------------------------------------------
' Проект     :  prjTel
' Процедура  :  GetData
' Описание   :  Получение данных по номеру телефона
' Кем создан :  SNE
' Дата-Время :  06.12.2004-2:32:46
'
' Параметры  :  inID    - Номер
'--------------------------------------------------------------------------------
Public Function GetData(ByVal inID As Long) As gbDBCard
    On Error GoTo err
    Dim rstTemp As New ADODB.Recordset

    With rstTemp
        Call .Open("SELECT NTEL, ABON, ADR FROM " & sTable & " WHERE NTEL = " & inID, DB)
        If Not .EOF Then
            GetData.szNumber = .Fields(0).Value

            If VBA.IsNull(.Fields(1).Value) Then GetData.szAbonent = sNone Else GetData.szAbonent = .Fields(1).Value
            If VBA.IsNull(.Fields(2).Value) Then GetData.szAdress = sNone Else GetData.szAdress = .Fields(2).Value
        End If
    End With

    On Error Resume Next
    Call rstTemp.Close
    Set rstTemp = Nothing
    Exit Function
err:
    Call ErrorHandler(err, "GetData"
End Function

' §§§§§§§§§§§§§§§§§§§§§§§§§§  §§§§§§§§§§§§§§§§§§§§§§§§§§

Private Sub ErrorHandler(ByRef objErr As ErrObject, _
                         ByRef strProcName As String)
    Call MsgBox("Ошибка в функции:" & vbCrLf & strProcName & vbCrLf & vbCrLf & "Описание:" & vbCrLf & objErr.Description, vbCritical)
End Sub