ms jet ace - How to extract the schema of an Access (.mdb) database?

Question

I am trying to extract the schema of an .mdb database, so that I can recreate the database elsewhere.

How can I pull off something like this?

Answer 1

It is possible to do a little with VBA. For example, here is a start on creating script for a database with local tables.

Dim db As Database
Dim tdf As TableDef
Dim fld As DAO.Field
Dim ndx As DAO.Index
Dim strSQL As String
Dim strFlds As String
Dim strCn As String

Dim fs, f

    Set db = CurrentDb

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.CreateTextFile("C:DocsSchema.txt")
    
    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) <> "Msys" Then
            strSQL = "strSQL=""CREATE TABLE [" & tdf.Name & "] ("
            
            strFlds = ""
            
            For Each fld In tdf.Fields
                
                strFlds = strFlds & ",[" & fld.Name & "] "
                
                Select Case fld.Type
                
                    Case dbText
                        'No look-up fields
                        strFlds = strFlds & "Text (" & fld.Size & ")"
                    
                    Case dbLong
                        If (fld.Attributes And dbAutoIncrField) = 0& Then
                            strFlds = strFlds & "Long"
                        Else
                            strFlds = strFlds & "Counter"
                        End If
    
                    Case dbBoolean
                        strFlds = strFlds & "YesNo"
    
                    Case dbByte
                        strFlds = strFlds & "Byte"
                        
                    Case dbInteger
                        strFlds = strFlds & "Integer"
                    
                    Case dbCurrency
                        strFlds = strFlds & "Currency"
            
                    Case dbSingle
                        strFlds = strFlds & "Single"
            
                    Case dbDouble
                        strFlds = strFlds & "Double"
            
                    Case dbDate
                        strFlds = strFlds & "DateTime"
            
                    Case dbBinary
                        strFlds = strFlds & "Binary"
            
                    Case dbLongBinary
                        strFlds = strFlds & "OLE Object"
                        
                    Case dbMemo
                        If (fld.Attributes And dbHyperlinkField) = 0& Then
                            strFlds = strFlds & "Memo"
                        Else
                            strFlds = strFlds & "Hyperlink"
                        End If
                        
                    Case dbGUID
                        strFlds = strFlds & "GUID"
                        
                End Select
            
            Next
    
            strSQL = strSQL & Mid(strFlds, 2) & " )""" & vbCrLf & "Currentdb.Execute strSQL"
            
            f.WriteLine vbCrLf & strSQL
        
            'Indexes
            For Each ndx In tdf.Indexes
            
                If ndx.Unique Then
                    strSQL = "strSQL=""CREATE UNIQUE INDEX "
                Else
                    strSQL = "strSQL=""CREATE INDEX "
                End If
                
                strSQL = strSQL & "[" & ndx.Name & "] ON [" & tdf.Name & "] ("
                
                strFlds = ""

                For Each fld In tdf.Fields
                    strFlds = strFlds & ",[" & fld.Name & "]"
                Next
                    
                strSQL = strSQL & Mid(strFlds, 2) & ") "
                
                strCn = ""
                
                If ndx.Primary Then
                    strCn = " PRIMARY"
                End If
                
                If ndx.Required Then
                    strCn = strCn & " DISALLOW NULL"
                End If
                
                If ndx.IgnoreNulls Then
                    strCn = strCn & " IGNORE NULL"
                End If
                
                If Trim(strCn) <> vbNullString Then
                    strSQL = strSQL & " WITH" & strCn & " "
                End If
                
                f.WriteLine vbCrLf & strSQL & """" & vbCrLf & "Currentdb.Execute strSQL"
            Next
        End If
    Next
        
    f.Close