blindsey wrote:
Is there a tool that can take an Access database and generate SQL
"CREATE TABLE" statements for all the tables in it?
the code below is not finished/polished, but it's a start.
Watch for wrapping... for your purpose, just call while looping
tabledefs, e.g.
For each tdf in db.tabledefs
DoSomethingWith CreateSQLTable(tdf.name)
next
Can always modify it to take tdf as parameter.
Function CreateSQLTable(pstrTableName As String, Optional pfGrantAll As
Boolean = False)
On Error GoTo CreateSQLTables_Err
' Returns T-SQL create table statement for an Access table
' © T.Best 2000-2004
' You may distribute/modify this as part of an application.
' May need additional work to handle more field types and unique
indices
Dim e As Error, strErrMsg As String
Dim db As Database, tdf As TableDef, fld As Field, idx As Index
Dim strSQL As String
Dim strSQLTable As String
Dim strField As String
Dim strSQLCreateTable As String
Set db = CodeDb()
strSQLTable = pstrTableName
Set tdf = db.TableDefs(pstrTableName)
' Build new
strSQL = ""
strSQL = strSQL & "create table " & strSQLTable & " (" & vbCrLf
For Each fld In tdf.Fields
strField = " [" & fld.Name & "] "
Select Case fld.Type
Case dbText
strField = strField & "varchar(" & fld.Size & ")"
Case dbDate
strField = strField & "datetime"
Case dbCurrency
strField = strField & "money"
Case dbLong
strField = strField & "int"
If fld.Attributes And dbAutoIncrField Then
strField = strField & " identity (1,1)"
End If
Case dbMemo
strField = strField & "text"
Case dbBoolean
strField = strField & "bit"
Case Else
Err.Raise 30001, , "Unknown field type ctrating table "
& strSQLTable & "." & fld.Name
End Select
If fld.Required Or fld.Attributes And dbAutoIncrField Then
strField = strField & " NOT NULL"
Else
strField = strField & " NULL"
End If
strSQL = strSQL & strField & "," & vbCrLf
Next
' strip off trailing "," & vbcrlf
strSQL = Left(strSQL, Len(strSQL) - 3)
strSQL = strSQL & ")"
strSQLCreateTable = strSQL
' Primary keys
For Each idx In tdf.Indexes
If idx.Primary Then
strSQL = "alter table " & strSQLTable & " with nocheck add"
& vbCrLf
strSQL = strSQL & " constraint [aaPK_" & strSQLTable & "]
primary key nonclustered" & vbCrLf
strSQL = strSQL & " (" & vbCrLf
For Each fld In idx.Fields
strSQL = strSQL & " [" & fld.Name & "]" & vbCrLf
Next
strSQL = strSQL & " ) with fillfactor = 90"
End If ' is PK
Next
strSQLCreateTable = strSQLCreateTable & vbCrLf & strSQL
' other indices
For Each idx In tdf.Indexes
If Not idx.Primary Then
' need a bit of work here to determine unique indices
strSQL = "create index " & idx.Name & " on " & strSQLTable
& "("
For Each fld In idx.Fields
strSQL = strSQL & "[" & fld.Name & "],"
Next
' strip trailing ",
strSQL = Left$(strSQL, Len(strSQL) - 1)
strSQL = strSQL & ") with fillfactor=90"
strSQLCreateTable = strSQLCreateTable & vbCrLf & strSQL
End If ' not PK
Next idx
' grant permissions
If pfGrantAll Then
strSQL = "grant select,insert,update,delete on " & strSQLTable
& " to public"
strSQLCreateTable = strSQLCreateTable & vbCrLf & strSQL
End If
CreateSQLTable = strSQLCreateTable
CreateSQLTables_Exit:
On Error Resume Next
Set idx = Nothing
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
Exit Function
CreateSQLTables_Err:
Select Case Err
Case 3146 ' ODBC
For Each e In DBEngine.Errors
strErrMsg = strErrMsg & "#ODBC Error " & e.number & " -
" & e.Description & vbCr
Next
MsgBox strErrMsg, vbExclamation, "Error " & Err.number & "
in Import2SQL()"
Case Else
MsgBox Err.Description, 16, "Error #" & Err & " In
CreateSQLTables()"
End Select
Resume CreateSQLTables_Exit
Resume
End Function
--
Pretentious? Moi?
