MyTetra Share
Делитесь знаниями!
Автоматическое обнуление подтаблиц в базе данных (для повышения производительности)
18.07.2018
20:03
Раздел: VBA - Access - msa.polarcom.ru

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

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




Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования