J'essaie d'extraire le schéma d'une base de données .mdb afin de pouvoir recréer la base de données ailleurs.
Comment puis-je retirer quelque chose comme ça?
Il est possible de faire un peu avec VBA. Par exemple, voici un début de création de script pour une base de données avec des tables locales.
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:\Docs\Schema.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 = ",[" & 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
C'est une question ancienne maintenant, mais malheureusement pérenne :(
J'ai pensé que ce code pourrait être utile à d'autres personnes à la recherche de solutions. Il est conçu pour être exécuté à partir de la ligne de commande via cscript. Il n'est donc pas nécessaire d'importer du code dans votre projet Access. Semblable à (et inspiré par) le code de Oliver dans Comment utilisez-vous le contrôle de version avec le développement Access .
' 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
'
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
Si vous souhaitez également exporter des définitions de requête, cette question devrait vous aider. C'est un peu différent parce que vous ne créez généralement pas querydefs avec une syntaxe DDL CREATE VIEW foo AS ...
simple, en fait, je ne suis pas sûr que vous puissiez le faire (?)
Mais voici un petit morceau de script que j'ai écrit pour sauvegarder des requêtes afin de séparer des fichiers .sql (qui fait partie d'un script plus grand pour sauvegarder tout le code de base de données front-end, voir la réponse d'Oliver pour cette question ).
Dim oApplication
Set oApplication = CreateObject("Access.Application")
oApplication.OpenCurrentDatabase sMyAccessFilePath
oApplication.Visible = False
For Each myObj In oApplication.DBEngine(0)(0).QueryDefs
writeToFile sExportpath & "\queries\" & myObj.Name & ".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
Le code C # suivant explique comment obtenir le schéma à partir d'un fichier .mdb.
Obtenir une connexion à la base de données:
String f = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + "database.mdb";
OleDbConnection databaseConnection = new OleDbConnection(f);
databaseConnection.Open();
Obtenez le nom de chaque table:
DataTable dataTable = databaseConnection.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, new object[] { null, null, null, "TABLE" });
int numTables = dataTable.Rows.Count;
for (int tableIndex = 0; tableIndex < numTables; ++tableIndex)
{
String tableName = dataTable.Rows[tableIndex]["TABLE_NAME"].ToString();
Obtenez les champs pour chaque table:
DataTable schemaTable = databaseConnection.GetOleDbSchemaTable(OleDbSchemaGuid.Columns, new object[] { null, null, tableName, null });
foreach (DataRow row in schemaTable.Rows)
{
String fieldName = row["COLUMN_NAME"].ToString(); //3
String fieldType = row["DATA_TYPE"].ToString(); // 11
String fieldDescription = row["DESCRIPTION"].ToString(); //27
}
}
D'où proviennent les 3
, 11
et 27
? Je les ai trouvés en inspectant DataRow.ItemArray
avec un débogueur, est-ce que quelqu'un sait comment s'y prendre?
Si vous préférez utiliser autre chose que du code d'accès SQL pur, vous pouvez conserver une collection d'objets ADOX et les utiliser pour recréer la structure de la table.
Exemple (en Python, ne recrée pas actuellement les relations et les index car cela n'était pas nécessaire pour le projet sur lequel je travaillais):
import os
import sys
import datetime
import comtypes.client as client
class Db:
def __init__(self, original_con_string = None, file_path = None,
new_con_string = None, localise_links = False):
self.original_con_string = original_con_string
self.file_path = file_path
self.new_con_string = new_con_string
self.localise_links = localise_links
def output_table_structures(self, verbosity = 0):
if os.path.exists(self.file_path):
if not os.path.isdir(self.file_path):
raise Exception("file_path must be a directory!")
else:
os.mkdir(self.file_path)
cat = client.CreateObject("ADOX.Catalog")
cat.ActiveConnection = self.original_con_string
linked_tables = ()
for table in cat.Tables:
if table.Type == u"TABLE":
f = open(self.file_path + os.path.sep +
"Tablestruct_" + table.Name + ".txt", "w")
conn = client.CreateObject("ADODB.Connection")
conn.ConnectionString = self.original_con_string
rs = client.CreateObject("ADODB.Recordset")
conn.Open()
rs.Open("SELECT TOP 1 * FROM [%s];" % table.Name, conn)
for field in rs.Fields:
col = table.Columns[field.Name]
col_details = (col.Name, col.Type, col.DefinedSize,
col.Attributes)
property_dict = {}
property_dict["Autoincrement"] = (
col.Properties["Autoincrement"].Value)
col_details += property_dict,
f.write(repr(col_details) + "\n")
rs.Close()
conn.Close()
f.close()
if table.Type == u"LINK":
table_details = table.Name,
table_details += table.Properties(
"Jet OLEDB:Link DataSource").Value,
table_details += table.Properties(
"Jet OLEDB:Link Provider String").Value,
table_details += table.Properties(
"Jet OLEDB:Remote Table Name").Value,
linked_tables += table_details,
if linked_tables != ():
f = open(self.file_path + os.path.sep +
"linked_list.txt", "w")
for t in linked_tables:
f.write(repr(t) + "\n")
cat.ActiveConnection.Close()
Une fonction inverse similaire reconstruit la base de données en utilisant la deuxième chaîne de connexion.
Vous pouvez utiliser le fournisseur de base de données ACE/Jet OLE et une méthode OpenSchema de l'objet de connexion ADO Connection pour obtenir des informations sur le schéma sous forme de jeu d'enregistrements (ce qui est plus avantageux qu'une collection, car elle peut être filtrée, triés, etc.).
La méthodologie de base consiste à utiliser adSchemaTables pour obtenir les tables de base (et non VIEW), puis à utiliser chaque TABLE_NAME pour rechercher adSchemaColumns pour ORDINAL_POSITION,! DATA_TYPE,!
adSchemaPrimaryKeys est simple. adSchemaIndexes est l'endroit où vous trouverez les contraintes UNIQUES, sans savoir si elles peuvent être distinguées des index uniques, ainsi que les noms des clés étrangères à connecter à l'ensemble de lignes adSchemaForeignKeys, par exemple. (pseudo code):
rsFK.Filter = "FK_NAME = '" & !INDEX_NAME & "'")
- surveillez le fait que Jet 3.51 autorise un FK basé sur un PK sans nom (!!)
Les noms des règles de validation et des contraintes CHECK peuvent être trouvés dans le jeu de lignes adSchemaTableConstraints, en utilisant le nom de la table dans l'appel OpenSchema, puis utilisez le nom dans l'appel du jeu de lignes adSchemaCheckConstraints, filtrez pour CONSTRAINT_TYPE = 'CHECK' 'ValidationRule' + Chr $ (0), il est donc préférable d'échapper aux caractères nuls du nom). N'oubliez pas que les règles de validation ACE/Jet peuvent être au niveau de la ligne ou de la table (les contraintes CHECK sont toujours au niveau de la table). Vous devrez donc peut-être utiliser le nom de la table dans le filtre: pour adSchemaTableConstraints est []. []. ValidationRule sera [] .ValidationRule dans adSchemaCheckConstraints. Un autre piège (bogue suspecté) est que le champ a une largeur de 255 caractères. Par conséquent, toute définition de contrainte Validation Rule/CHECK de plus de 255 caractères aura une valeur NULL.
adSchemaViews, pour les objets Access Query basés sur un SELECT DML SQL non paramérisé, est simple; vous pouvez utiliser le nom VIEW dans adSchemaColumns pour obtenir les détails de la colonne.
Les procédures se trouvent dans adSchemaProcedures, qui sont toutes les autres variétés d’objets d’Access Query, y compris SELECT DML paramétré; pour ce dernier, je préfère remplacer la syntaxe PARAMETERS par CREATE PROCEDURE PROCEDURE_NAME dans PROCEDURE_DEFINITION. Ne cherchez plus dans les paramètres adSchemaProcedureParameters, vous ne trouverez rien: les paramètres peuvent être énumérés à l'aide d'un objet ADOX Catalog pour renvoyer une commande ADO, par exemple. (pseudo code):
Set Command = Catalog.Procedures(PROCEDURE_NAME).Command
puis énumérer la collection Comm.Parameters pour .Name, .Type pour DATA_TYPE, (.Attributes et adParamNullable) pour IS_NULLABLE, .Value pour COLUMN_HASDEFAULT et COLUMN_DEFAULT, .Size, .Precision, .NumericScale.
Pour les propriétés spécifiques à ACE/Jet telles que la compression Unicode, vous devez utiliser un autre type d'objet. Par exemple, un numéro automatique long entier dans Access-speak peut être trouvé à l'aide d'un objet ADO Catalog, par exemple. (pseudo code):
bIsAutoincrement = Catalog.Tables(TABLE_NAME).Columns(COLUMN_NAME).Properties("Autoincrement").Value
Bonne chance :)
Compare'Em http://home.gci.net/~mike-noel/CompareEM-LITE/CompareEM.htm Sera heureux de générer le code VBA nécessaire pour recréer une MDB . Ou le code permettant de créer les différences entre deux MDB afin que vous puissiez effectuer une mise à niveau de la version de la MDB BE existante. C'est un peu bizarre mais ça marche. Notez qu'il ne prend pas en charge les nouveaux formats ACE (Access2007) ACCDB, etc.
Je l'utilise tout le temps.
(Le montage de OneDayWhen était correct sur un tiers et faux sur deux tiers.)
Découvrez la docmd. TransferDatabase command. C'est probablement votre meilleur choix pour une intégration de construction qui doit répliquer la structure de données.
Il est difficile de faire des requêtes/scripts DDL dans Access. Cela peut être fait, mais vous feriez mieux de créer une copie de la base de données - en supprimant toutes les données et en les compactant. Ensuite, utilisez une copie de ceci pour recréer la base de données ailleurs.
Post très utile!
J'ai révisé le script pour générer le langage de définition de données pour SQL Server. Je pensais que cela pourrait être utile à quelqu'un, alors je le partage. Le seul problème que j'ai rencontré est que le script VBS extrait tous les champs de la table pour les index. Je ne sais pas encore comment résoudre ce problème, alors je n'extrais que le premier champ. Cela fonctionnera pour la plupart des clés primaires. Enfin, tous les types de données ne sont pas éprouvés, mais je pense en avoir la plupart.
Option Compare Database
Function exportTableDefs()
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 fs, f
Set db = CurrentDb
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.CreateTextFile("C:\temp\Schema.txt")
For Each tdf In db.TableDefs
If Left(tdf.Name, 4) <> "Msys" And Left(tdf.Name, 1) <> "~" Then
strSQL = "CREATE TABLE [" & tdf.Name & "] (" & vbCrLf
strFlds = ""
For Each fld In tdf.Fields
strFlds = strFlds & ",[" & fld.Name & "] "
Select Case fld.Type
Case dbText
'No look-up fields
strFlds = strFlds & "varchar (" & fld.SIZE & ")"
Case dbLong
If (fld.Attributes And dbAutoIncrField) = 0& Then
strFlds = strFlds & "bigint"
Else
strFlds = strFlds & "int IDENTITY(1,1)"
End If
Case dbBoolean
strFlds = strFlds & "bit"
Case dbByte
strFlds = strFlds & "tinyint"
Case dbInteger
strFlds = strFlds & "int"
Case dbCurrency
strFlds = strFlds & "decimal(10,2)"
Case dbSingle
strFlds = strFlds & "decimal(10,2)"
Case dbDouble
strFlds = strFlds & "Float"
Case dbDate
strFlds = strFlds & "DateTime"
Case dbBinary
strFlds = strFlds & "binary"
Case dbLongBinary
strFlds = strFlds & "varbinary(max)"
Case dbMemo
If (fld.Attributes And dbHyperlinkField) = 0& Then
strFlds = strFlds & "varbinary(max)"
Else
strFlds = strFlds & "?"
End If
Case dbGUID
strFlds = strFlds & "?"
Case Else
strFlds = strFlds & "?"
End Select
strFlds = strFlds & vbCrLf
Next
'' get rid of the first comma
strSQL = strSQL & Mid(strFlds, 2) & " )" & vbCrLf
f.WriteLine strSQL
strSQL = ""
'Indexes
For Each ndx In tdf.Indexes
If Left(ndx.Name, 1) <> "~" Then
If ndx.Primary Then
strSQL = "ALTER TABLE " & tdf.Name & " ADD CONSTRAINT " & tdf.Name & "_primary" & " PRIMARY KEY CLUSTERED ( " & vbCrLf
Else
If ndx.Unique Then
strSQL = "CREATE UNIQUE NONCLUSTERED INDEX "
Else
strSQL = "CREATE NONCLUSTERED INDEX "
End If
strSQL = strSQL & "[" & tdf.Name & "_" & ndx.Name & "] ON [" & tdf.Name & "] ("
End If
strFlds = ""
''' Assume that the index is only for the first field. This will work for most primary keys
''' Not sure how to get just the fields in the index
For Each fld In tdf.Fields
strFlds = strFlds & ",[" & fld.Name & "] ASC "
Exit For
Next
strSQL = strSQL & Mid(strFlds, 2) & ") "
End If
Next
f.WriteLine strSQL & vbCrLf
End If
Next
f.Close
End Function