Автоматическое обнуление подтаблиц в базе данных (для повышения производительности)

По материалам: https://support.microsoft.com/ru-ru/kb/275085

Чтобы автоматически присвоить свойству Имя подтаблицы для всех несистемных таблиц в базе данных значение [ОТСУТСТВУЕТ], можно воспользоваться функцией на языке VBA (Visual Basic for Applications). Для этого выполните указанные ниже действия.

    01. Откройте базу данных таблиц.
    02. В окне базы данных нажмите кнопку Модули, а затем — Создать.
    03. В меню Tools выберите пункт References. Убедитесь, что флажок Microsoft DAO 3.6 Object Library установлен, и нажмите кнопку ОК.
    04. Вставьте в новый модуль приведенный ниже код.

Public Sub TurnOffSubDataSheets()
'Снятие ссылок Субтаблиц у всех таблиц базы для повышения производительности (по сети)
'--------------------------------------------------------------------
Dim db As DAO.Database
Dim DAO_Prp As DAO.Property
Dim propName As String, propVal As String, rplPropValue As String
Dim propType As Integer, i As Integer
Dim intCount As Integer

On Error GoTo tagError

    Set db = CurrentDb
    propName = "SubDataSheetName"
    propType = 10
    propVal = "[None]"
    rplPropValue = "[Auto]"
    intCount = 0

    For i = 0 To db.TableDefs.Count - 1
        If (db.TableDefs(i).Attributes And dbSystemObject) = 0 Then
            If db.TableDefs(i).Properties(propName).Value = rplPropValue Then
                 db.TableDefs(i).Properties(propName).Value = propVal
                 intCount = intCount + 1
            End If
        End If
tagFromErrorHandling:
    Next i

    db.Close

    If intCount = 0 Then
        MsgBox "The " & propName & " value for " & intCount & _
        " non-system tables has been updated to " & propVal & "."
    End If
Exit Sub

tagError:
    If Err.Number = 3270 Then
        Set DAO_Prp = db.TableDefs(i).CreateProperty(propName)
        DAO_Prp.Type = propType
        DAO_Prp.Value = propVal
        db.TableDefs(i).Properties.Append DAO_Prp
        intCount = intCount + 1
        Resume tagFromErrorHandling
    Else
        MsgBox Err.Description & vbCrLf & vbCrLf & " in TurnOffSubDataSheets routine."
    End If
End Sub