Is there any way to have MS Access 2003 generate a set of DDL, DML, and DCL files for an existing design and dataset?

Question

I have an existing database that has some testing data into and I'm interested in turning it into a set of DDL, DML, and DCL files so that I could run it against other database systems and create the same schema and such. The database is MS Access 2003.

Thoughts?

Answer 1

Just happened across this question... it's old, but for future reference, I wrote two cscripts that give you the DDL and DML from and Access dbase, pasted below. Only have used it vs Access 2003 files, but probably should work OK on Access 2007+ as well.

Also I am writing a database transfer tool in Ruby that mostly works with Access mdb files as the source, built on the Sequel database toolkit.

```cscript

' ddl.vbs
' Usage:
'  CScript //Nologo ddl.vbs <input mdb file> > <output>
'
' Outputs DDL statements for tables, indexes, and relations from Access file 
' (.mdb, .accdb) <input file> 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
'
' (c) 2012 Eric Gjertsen 
'     [email protected]
'
'Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'
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 " & QuoteObjectName(tdef.name) & " ("
    ln = vbCrLf

    For Each fld In tdef.fields
       sql = sql & ln & " " & QuoteObjectName(fld.name) & " "
       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(" & fld.Size & ")"
       Case dbGUID 'Text
          a = "GUID"
       Case Else
          '>>> raise error
          MsgBox "Field " & tdef.name & "." & fld.name & _
                " of type " & fld.Type & " has been ignored!!!"
       End Select

       sql = sql & a

       If fld.Required Then _
          sql = sql & " NOT NULL "
       If Len(fld.DefaultValue) > 0 Then _
          sql = sql & " DEFAULT " & fld.DefaultValue

       ln = ", " & vbCrLf
    Next

    sql = sql & vbCrLf & ");"
    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 & "UNIQUE "
       End If
       sql = sql & "INDEX " & QuoteObjectName(idx.name) & " ON " & _
             QuoteObjectName(tdef.name) & "( "
       For Each myfld In idx.fields
          sql = sql & ln & QuoteObjectName(myfld.name)
          ln = ", "
       Next
       sql = sql & " )"
       If idx.Primary Then
          sql = sql & " WITH PRIMARY"
       ElseIf idx.IgnoreNulls Then
          sql = sql & " WITH IGNORE NULL"
       ElseIf idx.Required Then
          sql = sql & " WITH DISALLOW NULL"
       End If
       sql = sql & ";"
    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 " & QuoteObjectName(.ForeignTable) & _
             " ADD CONSTRAINT " & QuoteObjectName(.name) & " FOREIGN KEY ( "
       ln = ""
       For Each myfld In .fields 'ie fields of the relation
          sql = sql & ln & QuoteObjectName(myfld.ForeignName)
          ln = ","
       Next
       sql = sql & " ) " & "REFERENCES " & _
             QuoteObjectName(.table) & "( "
       ln = ""
       For Each myfld In .fields
          sql = sql & ln & QuoteObjectName(myfld.name)
          ln = ","
       Next
       sql = sql & " )"
       If (myrel.Attributes And dbRelationUpdateCascade) Then _
             sql = sql & " ON UPDATE CASCADE"
       If (myrel.Attributes And dbRelationDeleteCascade) Then _
             sql = sql & " ON DELETE CASCADE"
       sql = sql & ";"
    End With
    getRelationDDL = sql
End Function


Function isSystemTable(tbl)
Dim nAttrib
Const dbSystemObject = -2147483646
    isSystemTable = False
    nAttrib = tbl.Attributes
    isSystemTable = (nAttrib <> 0 And ((nAttrib And dbSystemObject) <> 0))
End Function

Function isHiddenTable(tbl)
Dim nAttrib
Const dbHiddenObject = 1
    isHiddenTable = False
    nAttrib = tbl.Attributes
    isHiddenTable = (nAttrib <> 0 And ((nAttrib And dbHiddenObject) <> 0))
End Function

Function QuoteObjectName(str)
    QuoteObjectName = "[" & str & "]"
End Function

```

---

```cscript

' dump.vbs
' Usage:
'  CScript //Nologo dump.vbs access-file [table] > <output>
'
' Outputs INSERT SQL statements for all data in specified table of Access 
' file (.mdb, .accdb) to stdout. If no table specified, then statements are
' generated for all tables in Access file.
'
' Requires Microsoft Access.
'
' (c) 2012 Eric Gjertsen 
'     [email protected]
'
'Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'

Option Explicit
Dim stdout, stderr, fso
Dim strFile, strTbl
Dim appAccess, db, tbl, rst

Set stdout = WScript.StdOut
Set stderr = WScript.StdErr

Set fso = CreateObject("Scripting.FileSystemObject")

' Parse args
If (WScript.Arguments.Count = 0) then
    MsgBox "Usage: cscript //Nologo dump.vbs access-file [table]", vbExclamation, "Error"
    Wscript.Quit()
End if
strFile = fso.GetAbsolutePathName(WScript.Arguments(0))
strTbl  = ""
If WScript.Arguments.Count = 2 Then
  strTbl = WScript.Arguments(1)
End If

' Open mdb file
Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase strFile
Set db = appAccess.DBEngine(0)(0)

' Iterate over tables
  ' dump records as INSERT INTO statements
For Each tbl In db.TableDefs
  If (Len(strTbl)>0 And UCase(tbl.Name) = UCase(strTbl)) Or _
     (Len(strTbl)=0 And Not isSystemTable(tbl) And Not isHiddenTable(tbl)) Then
    Set rst = tbl.OpenRecordset
    If Not rst.EOF And Not rst.BOF Then
      rst.MoveFirst
      stderr.WriteLine "Dumping table " + tbl.Name
      While Not rst.EOF
        stdout.WriteLine getRecSQL(tbl, rst)
        rst.MoveNext
      Wend
      stdout.WriteBlankLines(1)
    End If
    stdout.WriteBlankLines(1)
  End if
Next


Function getRecSQL(tdef, rst)

  Dim fld, sql
  Dim flds, vals, i

  ReDim flds(tdef.Fields.count - 1)
  ReDim vals(tdef.Fields.count - 1)
  i = -1
  For Each fld In tdef.fields
    i = i + 1
    flds(i) = QuoteObjectName(fld.name)
    vals(i) = serializeValue(rst.Fields(fld.name).Value, fld.Type)
  Next

  sql = "INSERT INTO " & QuoteObjectName(tdef.Name) & " (" & Join(flds,",") & ") " & _
        "VALUES (" & Join(vals,",") & ");"

  getRecSQL = sql

End Function

Function serializeValue( val, fldType )
  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 a, ln
  ln = Chr(13) + Chr(10)

  If IsNull(val) Then 
    a = "Null"
  Else
    Select Case fldType
    Case dbBoolean, dbByte, dbCurrency, dbDouble, dbInteger, dbLong, dbDecimal, dbFloat, dbSingle, dbGUID
      a = CStr(val)
    Case dbDate
      a = "#" & CStr(val) & "#"
    Case dbMemo, dbText
      a = Chr(34) + Replace(Replace(val, Chr(34), Chr(34) + Chr(34)), ln, " ") + Chr(34) 
    Case Else
      '>>> raise error
      a = "Null"
    End Select
  End If

  serializeValue = a

End Function



Function isSystemTable(tbl)
Dim nAttrib
Const dbSystemObject = -2147483646
    isSystemTable = False
    nAttrib = tbl.Attributes
    isSystemTable = (nAttrib <> 0 And ((nAttrib And dbSystemObject) <> 0))
End Function

Function isHiddenTable(tbl)
Dim nAttrib
Const dbHiddenObject = 1
    isHiddenTable = False
    nAttrib = tbl.Attributes
    isHiddenTable = (nAttrib <> 0 And ((nAttrib And dbHiddenObject) <> 0))
End Function

Function QuoteObjectName(str)
    QuoteObjectName = "[" & str & "]"
End Function
```

Answer 2

1. If your target DB is MS SQL Server, you can use the upsizing wizard to port the access database. You can install and use the MS SQL Server Express Edition and pull the DDL from there.

2. MS Visio 2003 Enterprise has a Database Reverse Engineering tool that can import the objects from the Access database then export the SQL. (This used to be standard in Visio 2000, if you can get your hands on that).