VBScript to interrogate an Access database

I want to extract all the fields associated to my tables in my access database, to get an inventory of all the data objects. This has to populate a form I've created. I've copied an extract of code to determine whether an object in the database is a query or a table and I would like to alter this, if possible.

Any help will be appreciated

Option Compare Database
Option Explicit

Private Sub AddInventory(strContainer As String)
    Dim con As DAO.Container
    Dim db As DAO.Database
    D开发者_Go百科im doc As DAO.Document
    Dim rst As DAO.Recordset
    Dim intI As Integer
    Dim strType As String
    Dim varRetval As Variant

    On Error GoTo HandleErr

    ' You could easily modify this, using the
    ' OpenDatabase() function, to work on any database,
    ' not just the current one.
    varRetval = SysCmd(acSysCmdSetStatus, _
     "Retrieving " & strContainer & " container information...")
    Set db = CurrentDb
    Set con = db.Containers(strContainer)
    Set rst = db.OpenRecordset("zstblInventory")

    For Each doc In con.Documents
        If Not IsTemp(doc.Name) Then
            ' Handle the special queries case.
            ' Tables and queries are lumped together
            ' in the Tables container.
            If strContainer = "Tables" Then
                If IsTable(doc.Name) Then
                    strType = "Tables"
                Else
                    strType = "Queries"
                End If
            Else
                strType = strContainer
            End If
            rst.AddNew
                rst("Container") = strType
                rst("Owner") = doc.Owner
                rst("Name") = doc.Name
                rst("DateCreated") = doc.DateCreated
                rst("LastUpdated") = doc.LastUpdated
            rst.Update
        End If
    Next doc

ExitHere:
    If Not rst Is Nothing Then
        rst.Close
        Set rst = Nothing
    End If
    Exit Sub

HandleErr:
    MsgBox Err.Number & ": " & Err.Description, , _
     "AddInventory"
    Resume ExitHere
End Sub

Private Sub RebuildInventory()
    On Error GoTo HandleErr
    DoCmd.Hourglass True

    Me.lstInventory.RowSource = ""
    Call CreateInventory
    Me.lstInventory.RowSource = "SELECT ID, Container, Name, " & _
     "Format([DateCreated],'mm/dd/yy (h:nn am/pm)') AS [Creation Date], " & _
     "Format([lastUpdated],'mm/dd/yy (h:nn am/pm)') AS [Last Updated], " & _
     "Owner FROM zstblInventory ORDER BY Container, Name;"

ExitHere:
    DoCmd.Hourglass False
    Exit Sub

HandleErr:
    Resume ExitHere
End Sub

Private Sub CreateInventory()
    If (CreateTable()) Then
        ' These routines use the status line,
        ' so clear it once everyone's done.
        Call AddInventory("Tables")
        Call AddInventory("Forms")
        Call AddInventory("Reports")
        Call AddInventory("Scripts")
        Call AddInventory("Modules")
        Call AddInventory("Relationships")

        ' Clear out the status bar.
        Call SysCmd(acSysCmdClearStatus)
    Else
        MsgBox "Unable to create zstblInventory."
    End If
End Sub

Private Function CreateTable() As Boolean
    ' Return True on success, False otherwise
    Dim qdf As DAO.QueryDef
    Dim db As DAO.Database
    Dim strSQL As String

    On Error GoTo HandleErr
    Set db = CurrentDb()

    db.Execute "DROP TABLE zstblInventory"

    ' Create zstblInventory
    strSQL = "CREATE TABLE zstblInventory (Name Text (255), " & _
     "Container Text (50), DateCreated DateTime, " & _
     "LastUpdated DateTime, Owner Text (50), " & _
     "ID AutoIncrement Constraint PrimaryKey PRIMARY KEY)"
    db.Execute strSQL

    ' If you got here, you succeeded!
    db.TableDefs.Refresh
    CreateTable = True

ExitHere:
    Exit Function

HandleErr:
    Select Case Err
        Case 3376, 3011 ' Table or Object not found
            Resume Next
        Case Else
            CreateTable = False
    End Select
    Resume ExitHere
End Function

Private Function IsTable(ByVal strName As String)
    Dim tdf As DAO.TableDef
    Dim db As DAO.Database

    On Error Resume Next

    ' Normally, in a function like this,
    ' you would need to refresh the tabledefs
    ' collection for each call to the function.
    ' Since this slows down the function
    ' by a very large measure, this time,
    ' just Refresh the collection the first
    ' time, before you call this function.

    Set db = CurrentDb()

    ' See CreateTable().
    'db.Tabledefs.Refresh

    Set tdf = db.TableDefs(strName)
    IsTable = (Err.Number = 0)
    Err.Clear
End Function

Private Function IsTemp(ByVal strName As String)
    IsTemp = Left(strName, 7) = "~TMPCLP"
End Function

Private Sub cmdCreateInventory_Click()
    Call RebuildInventory
End Sub

Private Sub Detail0_Click()

End Sub

Private Sub Form_Open(Cancel As Integer)
    Call RebuildInventory
End Sub

Check out the source code in this answer. You should be able to modify it to do what you need. Unless, as Remou pointed out in his comment, you are working with a pre-2000 version of Access.