Binaryworld - How to generate Table Create script for all or one MS Access table usi ... [ VB -> Office ]

Many times I have been asked that is there any easy way to generate script of one or all MS Access tables so when you want to create new table with same structure you dont have to click and type thousnd times. Here is the solution for your problem.

Step-By-Step Example

- Create a form in your database
- Place one command button name it Command0 if its something else
- Copy/Paste the following code on the form code editor
- Run the form and click on the command button to see the script of all tables

Click here to copy the following block

'//This will generate DDL script from existing table and will
'//create a new table with same structure but with different table name
Private Sub Command0_Click()
  Dim tempDDLFile As String, sql As String
  Dim templateTblName As String
  Dim newTblName As String

  templateTblName = ""
  newTblName = ""

  tempDDLFile = "c:\tabledefs.sql"
  GnerateDDL tempDDLFile, templateTblName
  sql = ReadFromFile(tempDDLFile)

  '//Now run create script
  'DoCmd.RunSQL Replace(sql, templateTblName, newTblName)

  If MsgBox("Script generated Do you want to see the script file located at [" & tempDDLFile & "]?", vbYesNo) = vbNo Then
    On Error Resume Next
    Kill tempDDLFile
  Else
    Call Shell("notepad.exe " & tempDDLFile, vbNormalFocus)
  End If

End Sub

'//if tdname ="" then all tables will be scripted
Private Sub GnerateDDL(Optional tempFile As String = "c:\tabledefs.sql", Optional tdName As String = "")
  Dim td, t, i, fd, f, idx

  fd = FreeFile

  Open "c:\tabledefs.sql" For Output Access Write Lock Write As #fd
  For Each t In CurrentDb.TableDefs

    If (tdName <> "" And t.Name <> tdName) Then
      GoTo skip
    End If

    If t.Attributes = 0 Or t.Attributes = 536870912 Then             ' normal tables/linked tables only, please
      Print #fd, "create table ["; t.Name; "] (" & vbCrLf;
      i = 0
      For Each f In t.Fields
        If i > 0 Then Print #fd, ", " & vbCrLf; Else i = 1
        Print #fd, "["; f.Name; "] ";
        Select Case f.Type
          Case dbDate: Print #fd, "datetime"
          Case dbText: Print #fd, "text("; f.Size; ")";
          Case dbMemo: Print #fd, "longtext";
          Case dbBoolean: Print #fd, "bit";
          Case dbInteger: Print #fd, "short";
          Case dbLong: Print #fd, "long";
          Case dbCurrency: Print #fd, "currency";
          Case dbSingle: Print #fd, "single";
          Case dbDouble: Print #fd, "double";
          Case dbByte: Print #fd, "byte";
          Case dbLongBinary:
            If (f.Attributes And dbAutoIncrField) = dbAutoIncrField Then
              Print #fd, "counter";
            Else
              Print #fd, "longbinary";
            End If
          Case Else: Print #fd, "DAMNEDIFIKNOW";
        End Select
        If (f.Attributes And dbRequired) = dbRequired Then
          Print #fd, " not null";
        End If
      Next
      Print #fd, ")"
      For Each idx In t.Indexes
        Print #fd, "create ";
        If idx.Primary Or idx.Unique Then Print #fd, "unique ";
        Print #fd, "index ["; idx.Name; "] on ["; t.Name; "] ("
        i = 0
        For Each f In idx.Fields
          If i > 0 Then Print #fd, ", "; Else i = 1
          Print #fd, "["; f.Name; "]";
        Next

        If idx.Primary Then
          Print #fd, ") with primary"
        ElseIf idx.Required Then
          Print #fd, ") with disallow null"
        ElseIf idx.IgnoreNulls Then
          Print #fd, ") with ignore null"
        Else
          Print #fd, ")"
        End If
      Next
    End If

skip:
  Next
  Close #fd

End Sub

Public Function ReadFromFile(FilePath As String) As String
  Dim iFile As Integer
  Dim s As String
  '//Check for File Path
  If Dir(FilePath) = "" Then Exit Function

  On Error GoTo ErrorHandler:

  iFile = FreeFile
  Open FilePath For Input As #iFile
  s = Input(LOF(iFile), #iFile)
  ReadFromFile = s

ErrorHandler:
  If iFile > 0 Then Close #iFile
End Function