Нумерация записей в таблице (DAO + ADO)

Производит нумерацию записей в указанном поле указанной таблицы, что бывает полезно перед добавлением индекса, например.

Public Sub esRecordsNumbering(tabName As String, fldName As String, Optional StartNo As Long = 1)
'es 01.07.2011
'Нумерация записей в таблице или запросе на выборку
'--------------------------------------------------------------------
'Аргументы:
'   tabName = Название Таблицы или Запроса
'   fldName = Название обрабатываемого Поля
'   StartNo = Начальный Номер (по умолч = 1)
'--------------------------------------------------------------------
Dim rst As DAO.Recordset
'--------------------------------------------------------------------
On Error GoTo RecNumberingErr
    Set rst = CurrentDb.OpenRecordset(tabName, dbOpenDynaset)
    'Если нет записей то на выход
    If rst.EOF = True Then GoTo RecNumberingBye
    DoCmd.Hourglass True 'Курсор = часы
    
    With rst
        'Цикл до конца таблицы
        Do Until .EOF = True
            .Edit
            .Fields(fldName) = StartNo
            .Update
            StartNo = StartNo + 1
            .MoveNext
        Loop
    End With

RecNumberingBye:
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Err.Clear
    Exit Sub

RecNumberingErr:
    MsgBox "Процедура: esRecordsNumbering - привела к ошибке:" & vbCrLf & _
    Err.Description & "  ERR# " & Err.Number
    Resume RecNumberingBye
End Sub

Пример эксплуатации:

Private Sub btn_frm_Click()
    'Нумерация поля "nom_uved" в таблице "osnova"
     esRecordsNumbering "osnova", "nom_uved", 1
End Sub

Еще вариант:
Нумерация записей в таблице с отображением хода процесса в StatusBar

Public Sub esRecordsNumberingST(tabName As String, fldName As String, _
                                Optional StartNo As Long = 1)
'--------------------------------------------------------------------
'es 01.07.2011
'Нумерация записей в таблице или запросе с отображением информации в StatusBar
'--------------------------------------------------------------------
'Агрументы:
'   tabName = Название Таблицы
'   fldName = Название Поля
'   StartNo = Начальный Номер (по умолч = 1)
'--------------------------------------------------------------------
Dim rst As DAO.Recordset
Dim lngFiveProc As Long 'кол-во записей для 5% процесса
Dim z As Integer        'Счетчик процесса
'--------------------------------------------------------------------
On Error GoTo RecNumberingSTErr
    Set rst = CurrentDb.OpenRecordset(tabName, dbOpenDynaset)
    'Если нет записей то на выход
    If rst.EOF = True Then GoTo RecNumberingSTBye
    With rst
        .MoveLast
        .MoveFirst
        'Подсчет кол-ва записей для 5% работы
        lngFiveProc = CLng(.RecordCount / 20)
        DoCmd.Hourglass True 'Курсор = ЧАСЫ
        'Инициализация счетчика в StatusBar на 20 делений по 5% каждое
        SysCmd acSysCmdInitMeter, "Нумерация записей: ", 20
        'Цикл до конца таблицы
        Do Until .EOF = True
            .Edit
            .Fields(fldName) = StartNo
            .Update
            StartNo = StartNo + 1
            'Отображение процесса
            If StartNo Mod lngFiveProc = 0 Then
                z = z + 1
                SysCmd acSysCmdUpdateMeter, z
            End If
            .MoveNext
        Loop
    End With

RecNumberingSTBye:
    On Error Resume Next
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    rst.Close
    Set rst = Nothing
    Err.Clear
    SysCmd acSysCmdClearStatus 'Очистка бара
    Exit Sub

RecNumberingSTErr:
    MsgBox "Процедура: esRecordsNumberingST - привела к ошибке:" & vbCrLf & _
    Err.Description & "  ERR# " & Err.Number
    Resume RecNumberingSTBye
End Sub

ADO

Public Sub RecordsNumbering(sTableName$, sFieldName$, Optional StartNo& = 1)
'es 14.12.2016
'Нумерация записей в таблице (Наборе записей) ADO
'--------------------------------------------------------------------
'Аргументы:
'   sTableName = Название Таблицы
'   sFieldName = Название обрабатываемого Поля
'   StartNo = Начальный Номер (по умолч = 1)
'--------------------------------------------------------------------
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset   'объект набора данных
Dim sSql$
'--------------------------------------------------------------------
On Error GoTo RecordsNumbering_Err
    
    Set cnt = CurrentProject.Connection ' Локально
    Set rst = CreateObject("ADODB.Recordset")

    sSql = "SELECT " & sFieldName & " FROM " & sTableName & ";"
    rst.Open sSql, cnt, adOpenDynamic, adLockOptimistic
    
    'Если нет записей то на выход
    If rst.EOF = True Then GoTo RecordsNumbering_Bye
    DoCmd.Hourglass True 'Курсор = часы
    
    With rst
        'Цикл до конца таблицы
        Do Until .EOF = True
            .Fields(0) = StartNo
            .Update
            StartNo = StartNo + 1
            .MoveNext
        Loop
    End With

RecordsNumbering_Bye:
    DoCmd.Hourglass False 'Вернуть нормальный курсор
    On Error Resume Next
    rst.Close: Set rst = Nothing
    cnt.Close: Set cnt = Nothing
    Exit Sub

RecordsNumbering_Err:
    MsgBox "Процедура: RecordsNumbering - привела к ошибке:" & vbCrLf & Err.Description & "  ERR# " & Err.Number
    Resume RecordsNumbering_Bye
End Sub