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

По материалам: 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