[AccessD] database in a state by Admin such that it is prevented from being "accessed" - to read and import its objects via automation or db to db

I am trying to automate reference to a database, so that I can write the schema to an excel worksheet. What I do is look to see whatever is the currentdb object of the currently running instance of access, then note currentdb.name to get its path, then close it, and re-open it through automation. I TOTALLY HATE having to do that, however what I had found was that when I do not close the database, I get an error message about the database being placed in a status by user Admin which does not permit changes to it (including, apparently, looping through the properties of certain objects within the database). That is why I started closing it.

However ... I came to find out that for some databases, I do not run into that error message.

Is there a way to prevent the database, when opening, from being placed in that state that says others cannot access it? This would fix other problems I have found when, for example, I want to import tables and other objects from one open database into another. I often get a message from Access that the one I want to import FROM is placed in some state by User Admin which prevents its being opened.

HATE that.


TMIA....

Public Sub GetMySchema()
Dim T As Object
Dim f As Object
Dim Arr()
Dim strName As String
Dim UB As Long
Dim DB As Object
Dim i As Long
Dim WS As Worksheet

Set DB = GetDB   'Fetch and close the currentdb, then reopen it to be sure we have Admin privileges
'Retrieve the schema of the currentdb open in a single instance of Access
'         I would prefer to be able to do this
'          Set DB = GETOBJECT(,"Access.Application").GetDBEngine.Workspaces(0).OpenDatabase(strName)

ReDim Arr(1 To 4, 0 To 0)
For Each T In DB.TableDefs
    strName = UCase(T.Name)
  If Not InStr(strName, "MSYS") = 0 And InStr(strName, "SOLARCONNECT") = 0 And InStr(strName, "GIBIX_") = 0 Then
  
    For Each f In T.Fields
      UB = UB + 1
      If UB = 1 Then
        ReDim Arr(1 To 4, 1 To 1)
      Else
        ReDim Preserve Arr(1 To 4, 1 To UB)
      End If
      Arr(1, UB) = T.Name
      Arr(2, UB) = f.Name
      Select Case f.Type
      Case Is = 1
        'Boolean
        Arr(4, UB) = "NUMBER(1,0)"
    Case Is = 4
        Arr(4, UB) = "NUMBER(10)"
    Case Is = 5
        Arr(4, UB) = "NUMBER(12,2)"
    Case Is = 7
        Arr(4, UB) = "NUMBER(12)"
    Case Is = 8
        Arr(4, UB) = "DATE"
    Case Is = 10
        Arr(4, UB) = "VARCHAR2(" & f.Size & ")"
    Case Is = 12
        Arr(4, UB) = "VARCHAR2(4000)"
    Case Is = 101
        Arr(4, UB) = "BLOB"
    End Select
    Arr(3, UB) = IIf(f.Required, "NOT NULL", "")
      
    Next
...
END SUB

Public Function GetDB() As Object
Dim Ac As Object
Dim GetDBEngine As Object
Dim strName As String
On Error Resume Next
Set Ac = GetObject(, "Access.Application")
If Ac Is Nothing Then
  Exit Function
End If

'try 120


Set GetDBEngine = CreateObject("DAO.DBEngine.120")
If Err.Number <> 0 Then 'try 36
  Err.Clear
  Set GetDBEngine = CreateObject("DAO.DBEngine.36")
  If Err.Number <> 0 Then
    Set GetDBEngine = CreateObject("DAO.DBEngine.35")
  End If
End If
If Not GetDBEngine Is Nothing Then
    strName = Ac.currentdb.Name
    Ac.Quit
    DoEvents
    Set Ac = CreateObject("Access.Application")
    Set GetDB = GetDBEngine.Workspaces(0).OpenDatabase(strName)
End If

End Function