VBScript 询问 Access 数据库

Question

我想在我的 access 数据库中提取与我的表关联的所有字段，以获取所有数据对象的清单。这必须填充我创建的表单。我复制了一段代码以确定数据库中的对象是查询还是表，如果可能的话，我想更改它。

任何帮助将不胜感激

Option Compare Database
Option Explicit

Private Sub AddInventory(strContainer As String)
    Dim con As DAO.Container
    Dim db As DAO.Database
    Dim 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

Answer 1

查看answer 中的源代码。你应该能够修改它来做你需要的。除非，正如 Remou 在他的评论中指出的那样，您使用的是 2000 年前版本的 Access。