MyTetra Share
Делитесь знаниями!
Проверка наличия таблицы\запроса в базе
Время создания: 16.03.2019 23:43
Раздел: !Закладки - VBA - Access
Запись: xintrea/mytetra_db_adgaver_new/master/base/15063432180c9znbtg72/text.html на raw.githubusercontent.com

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

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

''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.59
Яндекс индекс цитирования