MyTetra Share
Делитесь знаниями!
Проверка наличия таблицы\запроса в базе
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access

''============================================================

''Проверить наличие таблицы\запроса

''http://www.programmersforum.ru/showthread.php?t=89869

'Sub testObjExists()

' Set oDb = CurrentDb 'OpenDatabase("strPath.mdb")

' ff = FnObjExists(oDb, "t", "Сотрудники2") '"Table", "Query",

' Set oDb = Nothing

'End Sub

''------------------------------------------------------------

Public Function FnObjExists(ByVal oDb As Object, _

ByVal strObjType As String, _

ByVal strObjName As String) As Boolean

On Error Resume Next

Select Case strObjType

Case "t": FnObjExists = (oDb.TableDefs(strObjName).Name = strObjName)

Case "z": FnObjExists = (oDb.QueryDefs(strObjName).Name = strObjName)

Case Else: FnObjExists = (oDb.Containers(strObjType & "s").Documents(strObjName).Name = strObjName)

End Select

Err.Clear

End Function

'============================================================

''============================================================

''Проверка существования таблицы

'Sub testIsTable()

' ff = IsTable("Сотрудники")

'End Sub

''------------------------------------------------------------

Public Function IsTable(ByVal NameTable As String) As Boolean

On Error GoTo IsTable_Err

Dim var

var = DCount("*", NameTable)

IsTable = True

Exit Function

IsTable_Err:

Select Case Err.Number

Case 3078

IsTable = False

Case Else

MsgBox Err.Number & " " & Err.Description

End Select

End Function

'============================================================

''============================================================

''Проверка существования таблицы2

'Sub testIsTable()

' ff = IsTable2("Сотрудники")

'End Sub

''------------------------------------------------------------

Public Function IsTable2(ByVal NameTable As String) As Boolean

Dim i As Integer

IsTable2 = False

For i = 0 To CurrentDb.TableDefs.Count - 1

If CurrentDb.TableDefs(i).Name = NameTable Then IsTable2 = True

Next i

End Function

'============================================================

'============================================================

'Удаление

'http://www.cyberforum.ru/ms-access/thread1513856.html

'Можно и так. Надо построить цикл по всей коллекции QueryDefs, _

сравнить с известным типов запросов Update, это тип=48, _

удалить их и обновить коллекцию QueryDefs. Цикл надо строить _

в обратном порядке от большего номера к меньшему.

'------------------------------------------------------------

Sub DelUpdQuery()

Dim db As DAO.Database, qdf As QueryDef, i

Set db = CurrentDb

For i = db.QueryDefs.Count - 1 To 0 Step -1 'Цикл по коллекции запросов

Set qdf = db.QueryDefs(i) 'Создание вспомогательного объекта коллекции

Debug.Print qdf.Name, qdf.Type 'Распечатка имен запросов и их типов

If qdf.Type = 48 Then 'Проверка на нужный тип запросов

db.QueryDefs.Delete qdf.Name 'Удаление объекта из коллекции

End If

Next

db.QueryDefs.Refresh 'Обновление все коллекции запросов

End Sub

'============================================================

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