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