Option Compare Database
'Option Explicit

Sub CreaDB()
Dim i As Long, Db As Object
Dim NewTbl As Object, NewFld As Object, NewIdx As Object
Dim CmdSQL As String

'Dim Db As database, NewTbl As TableDef
'Dim NewFld As Field, NewIdx As Index
Call AggiungiOCX("{00025E01-0000-0000-C000-000000000046}", "DAO", True)
Call AggiungiOCX("{00000205-0000-0010-8000-00AA006D2EA4}", "ADODB", True)


' ---------------------------------
' Elimino le vecchie tabelle
' ---------------------------------
On Error Resume Next
CurrentDb.Execute ("ALTER TABLE RigheFatture DROP CONSTRAINT TestataRighe1aN")
CurrentDb.Execute ("ALTER TABLE RigheFatture DROP CONSTRAINT ProdottiRighe1aN")
CurrentDb.Execute ("ALTER TABLE TestateFatture DROP CONSTRAINT ClientiTestate1aN")
On Error GoTo 0

Set Db = CurrentDb
For i = 0 To Db.TableDefs.Count - 1
If Db.TableDefs(i).Name = "Clienti" Then
Db.TableDefs.Delete "Clienti"
Exit For
End If
Next
For i = 0 To Db.TableDefs.Count - 1
If Db.TableDefs(i).Name = "Prodotti" Then
Db.TableDefs.Delete "Prodotti"
Exit For
End If
Next
For i = 0 To Db.TableDefs.Count - 1
If Db.TableDefs(i).Name = "RigheFatture" Then
Db.TableDefs.Delete "RigheFatture"
Exit For
End If
Next
For i = 0 To Db.TableDefs.Count - 1
If Db.TableDefs(i).Name = "TestateFatture" Then
Db.TableDefs.Delete "TestateFatture"
Exit For
End If
Next

' -------------------------------
' Tipi predefiniti
' -------------------------------
Const DbLong = 4
Const DbText = 10
Const dbLongBinary = 11
Const dbBoolean = 1
Const dbMemo = 12
Const dbInteger = 3
Const dbCurrency = 5
Const dbDate = 8
Const dbSingle = 6
Const dbByte = 2
Const dbDouble = 7



' ---------------------------------
' Clienti
' ---------------------------------
Set NewTbl = Db.CreateTableDef("Clienti")

Set NewFld = NewTbl.CreateField("IdCliente", DbLong)
NewFld.Attributes = dbAutoIncrField
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("RagioneSociale", DbText, 60)
NewFld.Required = True
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("Indirizzo", DbText, 60)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("Localita", DbText, 60)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("Provincia", DbText, 2)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("LogoAzienda", dbLongBinary)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("ClienteAttivo", dbBoolean)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("AltriCampi", dbMemo)
NewTbl.Fields.Append NewFld

Db.TableDefs.Append NewTbl

' ------------------------------------
' INDICI CLIENTE
' ------------------------------------
Set NewIdx = NewTbl.CreateIndex("IdCliente")
NewIdx.Fields.Append NewIdx.CreateField("IdCliente")
NewIdx.Primary = True
NewTbl.Indexes.Append NewIdx


Set NewIdx = NewTbl.CreateIndex("RagioneSociale")
NewIdx.Fields.Append NewIdx.CreateField("RagioneSociale")
NewIdx.Required = True
NewTbl.Indexes.Append NewIdx

' ---------------------------------
' Testate Fatture
' ---------------------------------
Set NewTbl = Db.CreateTableDef("TestateFatture")

Set NewFld = NewTbl.CreateField("IdFattura", DbLong)
NewFld.Attributes = dbAutoIncrField
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("IdCliente", DbLong)
NewFld.Required = True
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("NrFattura", DbText, 9)
NewFld.Required = True
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("Anno", dbInteger)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("Importo", dbCurrency)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("DataFattura", dbDate)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("AltriCampi", dbMemo)
NewTbl.Fields.Append NewFld

Db.TableDefs.Append NewTbl

' ------------------------------------
' INDICI TESTATA FATTURE
' ------------------------------------
Set NewIdx = NewTbl.CreateIndex("IdFattura")
NewIdx.Fields.Append NewIdx.CreateField("IdFattura")
NewIdx.Primary = True
NewTbl.Indexes.Append NewIdx

Set NewIdx = NewTbl.CreateIndex("IdCliente")
NewIdx.Fields.Append NewIdx.CreateField("IdCliente")
NewIdx.Required = True
NewTbl.Indexes.Append NewIdx

Set NewIdx = NewTbl.CreateIndex("NrFattura")
NewIdx.Fields.Append NewIdx.CreateField("NrFattura")
NewIdx.Unique = True
NewTbl.Indexes.Append NewIdx



' ---------------------------------
' Prodotti
' ---------------------------------
Set NewTbl = Db.CreateTableDef("Prodotti")

Set NewFld = NewTbl.CreateField("IdProdotto", DbLong)
NewFld.Attributes = dbAutoIncrField
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("DescrProdotto", DbText, 60)
NewFld.Required = True
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("Prezzo", dbSingle)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("CategoriaMerce", dbByte)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("AltriCampi", dbMemo)
NewTbl.Fields.Append NewFld

Db.TableDefs.Append NewTbl

' ------------------------------------
' INDICI PRODOTTI
' ------------------------------------
Set NewIdx = NewTbl.CreateIndex("IdProdotto")
NewIdx.Fields.Append NewIdx.CreateField("IdProdotto")
NewIdx.Primary = True
NewTbl.Indexes.Append NewIdx

Set NewIdx = NewTbl.CreateIndex("DescrProdotto")
NewIdx.Fields.Append NewIdx.CreateField("DescrProdotto")
NewIdx.Required = True
NewTbl.Indexes.Append NewIdx

' ---------------------------------
' Righe Fatture
' ---------------------------------
Set NewTbl = Db.CreateTableDef("RigheFatture")

Set NewFld = NewTbl.CreateField("IdRiga", DbLong)
NewFld.Attributes = dbAutoIncrField
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("IdFattura", DbLong)
NewFld.Required = True
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("IdProdotto", DbLong)
NewFld.Required = True
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("PrezzoUnitario", dbCurrency)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("Qta", dbDouble)
NewTbl.Fields.Append NewFld

Set NewFld = NewTbl.CreateField("AltriCampi", dbMemo)
NewTbl.Fields.Append NewFld

Db.TableDefs.Append NewTbl

' ------------------------------------
' INDICI RIGHE FATTURE
' ------------------------------------
Set NewIdx = NewTbl.CreateIndex("IdRiga")
NewIdx.Fields.Append NewIdx.CreateField("IdRiga")
NewIdx.Primary = True
NewTbl.Indexes.Append NewIdx

Set NewIdx = NewTbl.CreateIndex("IdFattura")
NewIdx.Fields.Append NewIdx.CreateField("IdFattura")
NewIdx.Required = True
NewTbl.Indexes.Append NewIdx

Set NewIdx = NewTbl.CreateIndex("IdProdotto")
NewIdx.Fields.Append NewIdx.CreateField("IdProdotto")
NewIdx.Required = True
NewTbl.Indexes.Append NewIdx

' ---------------------------------

Db.TableDefs.Refresh

Set Db = Nothing

' Generazione Relazioni
CmdSQL = "ALTER TABLE RigheFatture ADD CONSTRAINT TestataRighe1aN "
CmdSQL = CmdSQL & "Foreign KEY(IDFattura) REFERENCES TestateFatture (IDFattura)"
CurrentDb.Execute (CmdSQL)

CmdSQL = "ALTER TABLE RigheFatture ADD CONSTRAINT ProdottiRighe1aN "
CmdSQL = CmdSQL & "Foreign KEY(IDProdotto) REFERENCES Prodotti (IDProdotto)"
CurrentDb.Execute (CmdSQL)

CmdSQL = "ALTER TABLE TestateFatture ADD CONSTRAINT ClientiTestate1aN "
CmdSQL = CmdSQL & "Foreign KEY(IDCliente) REFERENCES Clienti (IDCliente)"
CurrentDb.Execute (CmdSQL)

' Inserimento Dati
CurrentDb.Execute ("INSERT INTO Prodotti VALUES (1,'Cacciaviti',6.01,20,'...');")
CurrentDb.Execute ("INSERT INTO Prodotti VALUES (2,'Martelli',11.09,20,'...');")
CurrentDb.Execute ("INSERT INTO Prodotti VALUES (3,'Chiodi',0.03,10,'...');")
CurrentDb.Execute ("INSERT INTO Prodotti VALUES (4,'Viti',0.02,10,'...');")

CurrentDb.Execute ("INSERT INTO Clienti (RagioneSociale, Provincia, ClienteAttivo) VALUES ('Rossi SPA','BS',true);")
CurrentDb.Execute ("INSERT INTO Clienti (RagioneSociale, Provincia, ClienteAttivo) VALUES ('Verdi Sas','BS',true);")
CurrentDb.Execute ("INSERT INTO Clienti (RagioneSociale, Provincia, ClienteAttivo) VALUES ('Gialli Srl','TN',true);")
CurrentDb.Execute ("INSERT INTO Clienti (RagioneSociale, Provincia, ClienteAttivo) VALUES ('F.lli Bandiera','BS',false);")

CurrentDb.Execute ("INSERT INTO TestateFatture (IdCliente, NrFattura, DataFattura) VALUES (1,'0001/08',#02/04/2008#);")
CurrentDb.Execute ("INSERT INTO TestateFatture (IdCliente, NrFattura, DataFattura) VALUES (2,'0002/08',#04/30/2008#);")
CurrentDb.Execute ("INSERT INTO TestateFatture (IdCliente, NrFattura, DataFattura) VALUES (1,'0003/08',#06/13/2008#);")
CurrentDb.Execute ("INSERT INTO TestateFatture (IdCliente, NrFattura, DataFattura) VALUES (3,'0001/09',#01/01/2009#);")
CurrentDb.Execute ("INSERT INTO TestateFatture (IdCliente, NrFattura, DataFattura) VALUES (1,'0002/09',#11/21/2009#);")

CurrentDb.Execute ("INSERT INTO RigheFatture VALUES (1,1,1,5.90,3,'...');")
CurrentDb.Execute ("INSERT INTO RigheFatture VALUES (2,2,1,5.90,10,'...');")
CurrentDb.Execute ("INSERT INTO RigheFatture VALUES (3,4,1,6.01,4,'...');")
CurrentDb.Execute ("INSERT INTO RigheFatture VALUES (4,1,2,10.01,2,'...');")
CurrentDb.Execute ("INSERT INTO RigheFatture VALUES (5,3,2,10.50,5,'...');")
CurrentDb.Execute ("INSERT INTO RigheFatture VALUES (6,5,2,11.09,4,'...');")
CurrentDb.Execute ("INSERT INTO RigheFatture VALUES (7,1,3,0.02,2,'...');")

End Sub

Public Function AggiungiOCX(NomeOCX As String, NomeReale As String, Optional IsGuidOCX As Boolean = False) As Boolean
Dim Trovato As Boolean
Dim Fatto As Boolean
Dim i As Integer
Trovato = False
Fatto = False
For i = 1 To References.Count
If References.Item(i).Name = NomeReale Then
Trovato = True
Fatto = True
End If
Next i
If Not Trovato Then
If IsGuidOCX Then
References.AddFromGuid NomeOCX, 1, 0
Else
References.AddFromFile (NomeOCX)
End If
Fatto = True
End If
AggiungiOCX = Fatto
End Function