Заполнение таблицы с выпадающим списком

Public Sub PrintAll_LookupFields_in_Tables(Optional bolFixProperty As Boolean = False)
' es 05.08.2019 - LE 19.07.2020 v003
' Проверка всех таблиц на наличие постановочных полей с возможностью исправления этого свойтва
' Информация выводится в Immediate Window (Ctrl + G):
' Список всех полей со свойством подстановки (Название Таблицы - Название поля)
'--------------------------------------------------------------------------
'Аргумент: bolFixProperty = Признак исправления свойства сразу после обнаружения
'                           bolFixProperty по умолчанию = False
'--------------------------------------------------------------------------
'Проверка на:
'    objField.Properties("DisplayControl").Value = 111(ComboBox) или 110(ListBox)
'    а если :
'    objField.Properties("DisplayControl").Value = 109(TextBox) = OK!
'--------------------------------------------------------------------------
'Заапуск с исправлением: PrintAll_LookupFields_in_Tables True
'--------------------------------------------------------------------------
Dim tdf As DAO.TableDef
Dim objField As DAO.Field
Dim bolHasPrp As Boolean
Dim objPrp As Property
Dim s$, sTName$, sFLDName$, sPrpName$, iTbls%, iErr%
Const iLineLength% = 72
'Линия над результатами:
    Debug.Print String(iLineLength, "-")
    
    For Each tdf In CurrentDb.TableDefs 'Перебор всех таблиц кроме системных
        If (tdf.Attributes And dbSystemObject) = False Then ' кроме системных
            sTName = tdf.Name
            iTbls = iTbls + 1 'Учёт
            For Each objField In tdf.Fields 'Перебор всех полей таблицы
                sFLDName = objField.Name
                'Наличие свойства "DisplayControl"
                bolHasPrp = CheckPropertyPresent(objField, "DisplayControl")
                If bolHasPrp = True Then
                    Set objPrp = objField.Properties("DisplayControl")
                    If objPrp.Value = 111 Or objPrp.Value = 110 Then
                        iErr = iErr + 1 'Учёт ошибок
                        If bolFixProperty = True Then 'Если заказано - испраляем:
                            objPrp.Value = 109 '109 = TextBox
                            s = vbTab & "Табл: [" & sTName & "]" & _
                                " - Поле: [" & sFLDName & "] " & _
                                "Свойство: [DisplayControl] " & _
                                " - исправлено на 109(TextBox)."
                        Else 'Показываем только отчёт:
                            s = "Табл: [" & sTName & "]" & _
                                " - Поле с подстановкой : " & sFLDName
                            Debug.Print s
                        End If
                        Debug.Print s
                    End If
                End If
            Next objField
        End If
    Next tdf
    
    If iErr > 0 Then  'Найдены ...
        Debug.Print String(iLineLength, "-") 'Линия под результатами
        If bolFixProperty = False Then
            s = "Обработано: " & iTbls & " таблиц" & _
                " - Найдено полей с подстановкой : " & iErr
        Else
            s = "Обработано: " & iTbls & " таблиц" & _
                " - Исправлено (удалено) полей с подстановкой : " & iErr
        End If
    Else 'Ничего не найдено - УРА!
        s = "Обработано: " & iTbls & " таблиц и полей с подстановкой не найдено!"
    End If
    Debug.Print s
    Debug.Print String(iLineLength, "=") 'Линия под отчётом
 
End Sub
 
 
Private Function CheckPropertyPresent(obj As Object, sPrpName$) As Boolean
'es - 19.07.2020
'Впомогательная функция - проверяет наличие заданного в аргументе свойства
'   у обьекта переданного в аргументе obj
' ------------------------------------------------------
Dim vVal
On Error GoTo CheckPropertyPresent_Err
    vVal = obj.Properties(sPrpName)
    CheckPropertyPresent = True
    
CheckPropertyPresent_End:
    Exit Function
 
CheckPropertyPresent_Err:
    'Debug.Print "CheckPropertyPresent_Line: " & Erl & "."
    Err.Clear
    Resume CheckPropertyPresent_End
End Function