Function EsaminaDB() As Boolean
' Funzione realizzata da Enrico Oemi
' Analizza il database corrente
' Utilizzata sotto Access 97
' Utile per valutare le dimensioni del DB, tempi di conversione, ecc.
Dim dbs As Database
Dim I, J As Integer
Dim tabelle As Integer
Dim tabella As TableDef
Dim tabelleSys As Integer
Dim campiSys As Integer
Dim campi As Integer
Dim fld As Field
Dim query As Integer
Dim Report As Integer
Dim maschere As Integer
Dim macro As Integer
Dim righeCodice As Long
Dim modulo As Module
Dim cicli, cicli1 As Integer
Dim resto As Integer
Dim name As String
Set dbs = CurrentDb
tabelle = dbs.TableDefs.count
'Inizializzo la barra di stato
SysCmd SYSCMD_INITMETER, "Conteggio tabelle e campi...", dbs.TableDefs.count
I = 0
tabelleSys = 0
For I = 0 To dbs.TableDefs.count - 1
Set tabella = dbs.TableDefs(I)
If tabella.name Like "msys*" Then
tabelleSys = tabelleSys + 1
campiSys = campiSys + tabella.Fields.count
Else
campi = campi + tabella.Fields.count
End If
SysCmd SYSCMD_UPDATEMETER, I + 1
Next I
tabelle = tabelle - tabelleSys
query = dbs.QueryDefs.count
'Inizializzo la barra di stato
SysCmd SYSCMD_INITMETER, "Conteggio forms, reports e macro...", 1
maschere = dbs.Containers("forms").Documents.count
Report = dbs.Containers("reports").Documents.count
macro = dbs.Containers("scripts").Documents.count
'Inizializzo la barra di stato
SysCmd SYSCMD_UPDATEMETER, 1
SysCmd SYSCMD_INITMETER, "Conteggio righe di codice... forms", maschere
On Error GoTo errore
For I = 0 To maschere - 1
DoCmd.OpenForm dbs.Containers("forms").Documents(I).name, acDesign, , , , acHidden
SysCmd SYSCMD_UPDATEMETER, (I + 1) / 2
Next I
For I = 0 To maschere - 1
name = dbs.Containers("forms").Documents(I).name
If Application.Forms(name).HasModule Then
righeCodice = righeCodice + Application.Forms(name).Module.CountOfLines
end if
DoCmd.Close acForm, Application.Forms(name).name
SysCmd SYSCMD_UPDATEMETER, maschere / 2 + (I + 1) / 2
Next I
'Inizializzo la barra di stato
SysCmd SYSCMD_INITMETER, "Conteggio righe di codice... reports", Report
DoCmd.Echo False
For I = 0 To Report - 1
DoCmd.OpenReport dbs.Containers("reports").Documents(I).name, acViewDesign
SysCmd SYSCMD_UPDATEMETER, (I + 1) / 2
Next I
DoCmd.Echo True
For I = 0 To Report - 1
name = dbs.Containers("reports").Documents(I).name
If Reports(name).HasModule Then
righeCodice = righeCodice + Reports(name).Module.CountOfLines
end if
DoCmd.Close acReport, Reports(name).name
SysCmd SYSCMD_UPDATEMETER, Report / 2 + (I + 1) / 2
Next I
'Inizializzo la barra di stato
SysCmd SYSCMD_INITMETER, "Conteggio righe di codice... moduli", Application.Modules.count
I = 0
For Each modulo In Application.Modules
I = I + 1
righeCodice = righeCodice + modulo.CountOfLines
SysCmd SYSCMD_UPDATEMETER, I
Next
' Chiude la barra di stato
SysCmd SYSCMD_REMOVEMETER
Debug.Print "-----------------------------------------------------------"
Debug.Print "File: " & dbs.name
Debug.Print "N° Tabelle ______________________________________", tabelle
Debug.Print " N° campi _______________________________________", campi
Debug.Print "N° Tabelle di sistema ___________________________", tabelleSys
Debug.Print " N° campi di sistema ____________________________", campiSys
Debug.Print "N° Query ________________________________________", query
Debug.Print "N° Report _______________________________________", Report
Debug.Print "N° Maschere _____________________________________", maschere
Debug.Print "N° Macro ________________________________________", macro
Debug.Print "N° Righe di codice (comprese maschere e report) _", righeCodice
MsgBox "N° Tabelle " & tabelle & Chr(10) & Chr(13) & _
" N° campi " & campi & Chr(10) & Chr(13) & _
"N° Tabelle di sistema " & tabelleSys & Chr(10) & Chr(13) & _
" N° campi di sistema " & campiSys & Chr(10) & Chr(13) & _
"N° Query " & query & Chr(10) & Chr(13) & _
"N° Report " & Report & Chr(10) & Chr(13) & _
"N° Maschere " & maschere & Chr(10) & Chr(13) & _
"N° Macro " & macro & Chr(10) & Chr(13) & _
"N° Righe di codice (comprese maschere e report) " & righeCodice
EsaminaDB = True
Exit Function
errore:
MsgBox "Errori DAO: " & (DAO.Errors.count - 2) & " SOURCE: " & DAO.Errors(0).Source & Chr(10) & Chr(13) & _
" DESCR: " & DAO.Errors(0).Description & Chr(10) & Chr(13) & _
" HELP: " & DAO.Errors(0).HelpContext & " " & DAO.Errors(0).HelpFile & " " & DAO.Errors(0).Number
DoCmd.Echo True
EsaminaDB = False
End Function
|