Blog
Come estrarre lo schema di un intero db access per replicarne la struttura in un solo click
Quando hai la necessità di estrapolare lo schema di un DB Access per replicarne la struttura può tornare utile questo codice che inserito in un semplice scrip nello stesso DB Access genera localmente un file di testo con all’interno le Stringhe CREATE per replicarne la struttura!
Ecco il codice perfettamente funzionante!
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
