Помогите с заполнением таблицы.

SELECT Должности.Код, Должности.Должность, Должности.КодСлужбы FROM Должности WHERE (((Должности.Код) Not In (3,6,7,44,45,46)));

Option Compare Database
Option Explicit
 
 
Private Sub ДатаД_Dirty(Cancel As Integer)
 
End Sub
 
Private Sub ДатаД_LostFocus()
Me.Удостоверение.Requery
End Sub
 
Private Sub Должность_AfterUpdate()
Me.НазваниеСлужбы = DLookup("названиеслужбы", "службы", "код_службы = " & Me.Должность.Column(2))
Me.КодСлужбы = Me.Должность.Column(2)
End Sub
 
Private Sub Кнопка109_Click()
 
End Sub
 
Private Sub кнопка4_Click()
Dim s As String
Dim l As Long
 If Me!Удостоверение.ListIndex = -1 Then
        MsgBox "ВВЕДИТЕ ТАБЕЛЬНЫЙ НОМЕР!", vbExclamation
        Me!Удостоверение.SetFocus
        Exit Sub
    End If
    
    If IsNull(Me!Должность) = True Then
        MsgBox "ВЫБЕРИТЕ ДОЛЖНОСТЬ!", vbExclamation
        Me!Должность.SetFocus
        Exit Sub
    End If
 
'Проверка
    'Debug.Print Me!Удостоверение
    
    s = "дата=" & Format(Me!Дата, "\#mm\/dd\/yyyy\#")
    s = DCount("*", "РабДень", " Удостоверение = " & Me.Удостоверение & " AND Дата=" & Format(Me!Дата, "\#mm\/dd\/yyyy\#"))  'всего записей
    If s >= 1 Then
        MsgBox "ВНИМАНИЕ! ДАННЫЙ ТАБ.НОМЕР УЖЕ НАЗНАЧЕН НА ДОЛЖНОСТЬ!" & vbCrLf & "пожалуйста, введите другой табельный номер!"
        Exit Sub
    End If
    
    s = "дата=" & Format(Me!Дата, "\#mm\/dd\/yyyy\#")
    l = DCount("*", "РабДень", s) 'всего записей
 
    'Debug.Print l
    If l >= 120 Then
        MsgBox "РАПОРТ ПОЛНОСТЬЮ СФОРМИРОВАН (120 человек)", vbExclamation
        Me!Дата.SetFocus
        Exit Sub
    End If
 
'Добавление
    Me.Dirty = False
    
    If Me!Удостоверение.ListIndex > -1 Then 'значение выбрано!
        s = "UPDATE Запись SET В_рапорте = True WHERE Удостоверение = " & Me!Удостоверение.Column(1)
        'Debug.Print s
        CurrentDb.Execute s
    Else
        MsgBox "Обновление таблицы [Запись] не возможно." & vbCrLf & "Поле [Удостоверение] не установлено!", vbExclamation
    End If
    
    s = "НАЗНАЧЕНИЕ НА ДОЛЖНОСТЬ ВЫПОЛНЕНО!" & vbCrLf & "ВСЕГО НАЗНАЧЕНО: " & l + 1 & " "
    MsgBox s, vbInformation
    DoCmd.RunCommand acCmdRecordsGoToNew
 
 
End Sub
 
Private Sub Удостоверение_AfterUpdate()
 
Me.Смена = DLookup("смена", "южд", "код = " & Me.Удостоверение.Column(0))
Me.Ф_И = DLookup("Фамилия_ЮЖД", "южд", "код = " & Me.Удостоверение.Column(0)) & " " & DLookup("Имя_ЮЖД", "южд", "код = " & Me.Удостоверение.Column(0))
 
End Sub
 
Private Sub Удостоверение_NotInList(NewData As String, Response As Integer)
MsgBox "ВНИМАНИЕ! ДАННЫЙ ТАБ.НОМЕР ОТСУТСТВУЕТ!" & vbCrLf & "данный таб. номер не записан на текущую дату!"
DoCmd.OpenForm "Запись в рапорт"
DoCmd.RunCommand acCmdRecordsGoToNew
DoCmd.Close acForm, Me.Name 'Закрытие текущей
 
 
 
 
End Sub
 
Private Sub Me_AfterUpdate()
Cancel = True
End Sub