Note that there are some explanatory texts on larger screens.

plurals
  1. PO
    primarykey
    data
    text
    <p>It's an ancient question now, but unfortunately perennial :(</p> <p>I thought this code may be of use to others looking for solutions. It's designed to be run from the command line via cscript, so no need to import code into your Access project. Similar to (and inspired by) the code from <a href="https://stackoverflow.com/users/28828/oliver">Oliver</a> in <a href="https://stackoverflow.com/questions/187506/how-do-you-use-version-control-with-access-development">How do you use version control with Access development</a>.</p> <pre class="lang-vba prettyprint-override"><code>' Usage: ' CScript //Nologo ddl.vbs &lt;input mdb file&gt; &gt; &lt;output&gt; ' ' Outputs DDL statements for tables, indexes, and relations from Access file ' (.mdb, .accdb) &lt;input file&gt; to stdout. ' Requires Microsoft Access. ' ' NOTE: Adapted from code from "polite person" + Kevin Chambers - see: ' http://www.mombu.com/microsoft/comp-databases-ms-access/t-exporting-jet-table-metadata-as-text-119667.html ' Option Explicit Dim stdout, fso Dim strFile Dim appAccess, db, tbl, idx, rel Set stdout = WScript.StdOut Set fso = CreateObject("Scripting.FileSystemObject") ' Parse args If (WScript.Arguments.Count = 0) then MsgBox "Usage: cscript //Nologo ddl.vbs access-file", vbExclamation, "Error" Wscript.Quit() End if strFile = fso.GetAbsolutePathName(WScript.Arguments(0)) ' Open mdb file Set appAccess = CreateObject("Access.Application") appAccess.OpenCurrentDatabase strFile Set db = appAccess.DBEngine(0)(0) ' Iterate over tables ' create table statements For Each tbl In db.TableDefs If Not isSystemTable(tbl) And Not isHiddenTable(tbl) Then stdout.WriteLine getTableDDL(tbl) stdout.WriteBlankLines(1) ' Iterate over indexes ' create index statements For Each idx In tbl.Indexes stdout.WriteLine getIndexDDL(tbl, idx) Next stdout.WriteBlankLines(2) End If Next ' Iterate over relations ' alter table add constraint statements For Each rel In db.Relations Set tbl = db.TableDefs(rel.Table) If Not isSystemTable(tbl) And Not isHiddenTable(tbl) Then stdout.WriteLine getRelationDDL(rel) stdout.WriteBlankLines(1) End If Next Function getTableDDL(tdef) Const dbBoolean = 1 Const dbByte = 2 Const dbCurrency = 5 Const dbDate = 8 Const dbDouble = 7 Const dbInteger = 3 Const dbLong = 4 Const dbDecimal = 20 Const dbFloat = 17 Const dbMemo = 12 Const dbSingle = 6 Const dbText = 10 Const dbGUID = 15 Const dbAutoIncrField = 16 Dim fld Dim sql Dim ln, a sql = "CREATE TABLE " &amp; QuoteObjectName(tdef.name) &amp; " (" ln = vbCrLf For Each fld In tdef.fields sql = sql &amp; ln &amp; " " &amp; QuoteObjectName(fld.name) &amp; " " Select Case fld.Type Case dbBoolean 'Boolean a = "BIT" Case dbByte 'Byte a = "BYTE" Case dbCurrency 'Currency a = "MONEY" Case dbDate 'Date / Time a = "DATETIME" Case dbDouble 'Double a = "DOUBLE" Case dbInteger 'Integer a = "INTEGER" Case dbLong 'Long 'test if counter, doesn't detect random property if set If (fld.Attributes And dbAutoIncrField) Then a = "COUNTER" Else a = "LONG" End If Case dbDecimal 'Decimal a = "DECIMAL" Case dbFloat 'Float a = "FLOAT" Case dbMemo 'Memo a = "MEMO" Case dbSingle 'Single a = "SINGLE" Case dbText 'Text a = "VARCHAR(" &amp; fld.Size &amp; ")" Case dbGUID 'Text a = "GUID" Case Else '&gt;&gt;&gt; raise error MsgBox "Field " &amp; tdef.name &amp; "." &amp; fld.name &amp; _ " of type " &amp; fld.Type &amp; " has been ignored!!!" End Select sql = sql &amp; a If fld.Required Then _ sql = sql &amp; " NOT NULL " If Len(fld.DefaultValue) &gt; 0 Then _ sql = sql &amp; " DEFAULT " &amp; fld.DefaultValue ln = ", " &amp; vbCrLf Next sql = sql &amp; vbCrLf &amp; ");" getTableDDL = sql End Function Function getIndexDDL(tdef, idx) Dim sql, ln, myfld If Left(idx.name, 1) = "{" Then 'ignore, GUID-type indexes - bugger them ElseIf idx.Foreign Then 'this index was created by a relation. recreating the 'relation will create this for us, so no need to do it here Else ln = "" sql = "CREATE " If idx.Unique Then sql = sql &amp; "UNIQUE " End If sql = sql &amp; "INDEX " &amp; QuoteObjectName(idx.name) &amp; " ON " &amp; _ QuoteObjectName(tdef.name) &amp; "( " For Each myfld In idx.fields sql = sql &amp; ln &amp; QuoteObjectName(myfld.name) ln = ", " Next sql = sql &amp; " )" If idx.Primary Then sql = sql &amp; " WITH PRIMARY" ElseIf idx.IgnoreNulls Then sql = sql &amp; " WITH IGNORE NULL" ElseIf idx.Required Then sql = sql &amp; " WITH DISALLOW NULL" End If sql = sql &amp; ";" End If getIndexDDL = sql End Function ' Returns the SQL DDL to add a relation between two tables. ' Oddly, DAO will not accept the ON DELETE or ON UPDATE ' clauses, so the resulting sql must be executed through ADO Function getRelationDDL(myrel) Const dbRelationUpdateCascade = 256 Const dbRelationDeleteCascade = 4096 Dim mytdef Dim myfld Dim sql, ln With myrel sql = "ALTER TABLE " &amp; QuoteObjectName(.ForeignTable) &amp; _ " ADD CONSTRAINT " &amp; QuoteObjectName(.name) &amp; " FOREIGN KEY ( " ln = "" For Each myfld In .fields 'ie fields of the relation sql = sql &amp; ln &amp; QuoteObjectName(myfld.ForeignName) ln = "," Next sql = sql &amp; " ) " &amp; "REFERENCES " &amp; _ QuoteObjectName(.table) &amp; "( " ln = "" For Each myfld In .fields sql = sql &amp; ln &amp; QuoteObjectName(myfld.name) ln = "," Next sql = sql &amp; " )" If (myrel.Attributes And dbRelationUpdateCascade) Then _ sql = sql &amp; " ON UPDATE CASCADE" If (myrel.Attributes And dbRelationDeleteCascade) Then _ sql = sql &amp; " ON DELETE CASCADE" sql = sql &amp; ";" End With getRelationDDL = sql End Function Function isSystemTable(tbl) Dim nAttrib Const dbSystemObject = -2147483646 isSystemTable = False nAttrib = tbl.Attributes isSystemTable = (nAttrib &lt;&gt; 0 And ((nAttrib And dbSystemObject) &lt;&gt; 0)) End Function Function isHiddenTable(tbl) Dim nAttrib Const dbHiddenObject = 1 isHiddenTable = False nAttrib = tbl.Attributes isHiddenTable = (nAttrib &lt;&gt; 0 And ((nAttrib And dbHiddenObject) &lt;&gt; 0)) End Function Function QuoteObjectName(str) QuoteObjectName = "[" &amp; str &amp; "]" End Function </code></pre> <p>If you are looking to export query definitions as well, <a href="https://stackoverflow.com/questions/1275502/using-vba-to-export-all-ms-access-sql-queries-to-text-files">this question</a> should help. It's a little different because you don't usually create querydefs with plain DDL <code>CREATE VIEW foo AS ...</code> syntax, in fact I'm not sure you can (?)</p> <p>But here's a little piece of a script I wrote for backing up queries to separate .sql files (which is part of a larger script for backing up all front-end db code, see Oliver's answer for <a href="http://stackoverflow.com/questions/187506/how-do-you-use-version-control-with-access-development">this question</a>).</p> <pre class="lang-vba prettyprint-override"><code>Dim oApplication Set oApplication = CreateObject("Access.Application") oApplication.OpenCurrentDatabase sMyAccessFilePath oApplication.Visible = False For Each myObj In oApplication.DBEngine(0)(0).QueryDefs writeToFile sExportpath &amp; "\queries\" &amp; myObj.Name &amp; ".sql", myObj.SQL Next Function writeToFile(path, text) Dim fso, st Set fso = CreateObject("Scripting.FileSystemObject") Set st = fso.CreateTextFile(path, True) st.Write text st.Close End Function </code></pre>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. VO
      singulars
      1. This table or related slice is empty.
    2. VO
      singulars
      1. This table or related slice is empty.
    3. VO
      singulars
      1. This table or related slice is empty.
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload