Ok, nel frattempo che ci pensi, ti propongo questa traccia.
Questa è una piccola analisi di come impostare ed eseguire un tracciamento per le routine invocate nel/dal progetto.
Solo un semplice esempio per far vedere una delle tante possibili soluzioni per tracciare tali eventi e analizzarli a proprio piacimento.
Eventualmente implementare controlli e attività che possono essere ulteriormente eseguite.
Si raccomanda di testare e "prova a provare" ;-) se soddisfa le tue esigenze.
ATTENZIONE !!! prima di apportare le modifiche, eseguire sempre le copie di riserva/salvataggio/backup delprogetto. (mi raccomando)
In Sintesi….
Tracing of the invoked routines :
- Si crea un modulo code di nome MyTraceDataAnalysis per inizializzare e impostare la fase di tracciamento e analisi
- Si imposta nel progetto il riferimento alla libreria:
- Microsoft Visual Basic for Applications Extensibility 5.3
- Per iniziare il tracciamento si richiama la Sub MyTableDataTrace
- Per ogni routine in tutti i moduli VBA, viene scritta (aggiunta) una nuova riga di codice subito dopo la dichiarazione delle varie Sub e Function, atta al tracciamento delle routine invocate durante l’esecuzione del progetto
- Eseguire il progetto in tutte le sue parti, se necessario anche per alcuni giorni
- In questa fase viene implementato il tracciamento per tutte le routine che verranno invocate
- A fine della fase 4. eseguire l’analisi del tracciamento
- Tramite delle query, report, etc… che possono essere create a proprio piacimento interrogando la tabella MyTableDataTrace
- Ripristino codice VBA del progetto
- Al termine della propria analisi sarà possibile richiamare la MyRemoveUpdateTraceCalls per ripristinare il codice VBA originale senza l’esecuzione del tracciamento
.
Analisi Dettagliata :
MyTableDataTrace
- Inizializzazione Trace :
- Elimina e ricrea la tabella di trace MyTableTrace
- Legge tutti i moduli e routine presenti nel VBA
- Inserisce nella tabella di trace tutte le routine presenti nel VBA
- Crea in una collection la lista con tutti i moduli e routine da tracciare
.
MyUpdateProceduresWithTrace
- Viene richiamata dalla Sub MyTableDataTrace :
- Legge tutta la trace collection
- Inserisce in ogni routine il richiamo di MyUpdateTraceNumber per il tracciamento
.
MySaveAndCloseObgjFormAndReport
- Viene richiamata alla fine della Sub MyTableDataTrace :
- Salva e Chiude tutte le finestre di progettazione
.
A questo punto troviamo in tutte le routine del progetto, il richiamo della Sub MyUpdateTraceNumber che traccerà quante volte la routine viene invocata.
MyUpdateTraceNumber
- Aggiorna la tabella di trace MyTableTrace incrementato il contatore di utilizzo per ogni routine invocata nel progetto.
.
Esempio di come vengono modificate le routine presenti nei vari moduli del progetto: (evidenziato in giallo la riga di codice che viene aggiunta nelle varie routine)
.
Analisi tabella di trace MyTableTrace
- Eseguire una query sulla tabella
- È possibile determinare le routine che non vengono utilizzate, selezionando solo i records dove “TraceNumber” risulta essere = 0
- ESEMPIO Tabella tracciamento :
La query per esempio può essere impostata :
In questo caso si elencano tutte le routine non ancora richiamate in fase di esecuzione del progetto. Vedere la colonna TraceNumber come illustrato nell'analisi
.
MyRemoveUpdateTraceCalls
- Al termine dell’anali può essere richiamata questa routine che permette di rimuovere da tutte le routine del progetto, la call di tracciamento MyUpdateTraceNumber
.
Infine....
Questo il Codice di esempio: (creare il Modulo MyTraceDataAnalysis ed inserire il codice)
Ho cercato di commentare le righe di codice il più possibile per una migliore comprensione.
Prova a provare ;-) e fai sapere se fa al caso tuo.
Option Compare Database
Option Explicit
' Inizialize trace const string - VBA code modules to be excluded from Trace
Public Const modCodeTrace As String = "MyTraceDataAnalysis"
' INITIALIZE NEW TRACE TABLE
Sub MyTableDataTrace()
' Set reference VBIDE
Dim vbComp As VBIDE.VBComponent
Dim vbModule As VBIDE.codeModule
Dim vbKind As VBIDE.vbext_ProcKind
Dim vbModuleName As String
Dim vbTotalLineModule As Long
' Set procedure variables
Dim procedureName As String
Dim procedureType As String
Dim procedureAccess As String
Dim procedureTraceRoutine As String
' Set count variables
Dim i As Long
Dim countLine As Long
Dim startLine As Long
Dim numberLine As Long
Dim procLine As String
Dim procLCaseLine As String
' Array to store procedure data for later update
Dim proceduresToUpdate As Collection
Set proceduresToUpdate = New Collection
' Set error handler
On Error GoTo ErrorHandler
' set ado current db
Dim db As DAO.Database
Set db = CurrentDb
' Check if the table exists and remove
If DCount("*", "MSysObjects", "Name='MyTableTrace' AND Type=1") > 0 Then db.Execute "DROP TABLE MyTableTrace"
' Create trace table
db.Execute "CREATE TABLE MyTableTrace (TraceID AUTOINCREMENT PRIMARY KEY, TraceModule TEXT(255), TraceRoutine TEXT(255), TraceNumber LONG)"
' Read all module
For Each vbComp In Application.VBE.ActiveVBProject.VBComponents
' Retrieve module name
vbModuleName = vbComp.Name
' Retrieve total line number in the module
Set vbModule = vbComp.codeModule
vbTotalLineModule = vbModule.CountOfLines
' Skip the MyTraceDataAnalysis module and form
If vbModuleName <> modCodeTrace Then
countLine = 1
' Read module line
Do While countLine <= vbTotalLineModule
procedureName = vbModule.ProcOfLine(countLine, vbKind)
' Check and normalize procedure name and type
If procedureName <> "" Then
' Retrieve starting line and length
startLine = vbModule.procStartLine(procedureName, vbKind)
numberLine = vbModule.ProcCountLines(procedureName, vbKind)
' Scan until we find the first non empty, non comment line
procLine = ""
For i = 0 To numberLine - 1
procLCaseLine = LCase(Trim(vbModule.Lines(startLine + i, 1)))
If procLCaseLine <> "" And Left(procLCaseLine, 1) <> "'" Then
procLine = procLCaseLine
Exit For
End If
Next i
' Normalize access type
If InStr(procLine, "public") > 0 Then
procedureAccess = "Public"
ElseIf InStr(procLine, "private") > 0 Then
procedureAccess = "Private"
Else
procedureAccess = ""
End If
' Normalize procedure type
If InStr(procLine, "sub") > 0 Then
procedureType = "Sub"
ElseIf InStr(procLine, "function") > 0 Then
procedureType = "Function"
ElseIf InStr(procLine, "property") > 0 Then
procedureType = "Property"
Else
procedureType = "Unknown"
End If
' Retrieve full procedure description
procedureTraceRoutine = IIf(procedureAccess <> "", procedureAccess & " ", "") & procedureType & " " & procedureName
' Insert into table
db.Execute "INSERT INTO MyTableTrace (TraceModule, TraceRoutine, TraceNumber) " & _
"VALUES ('" & vbModuleName & "', '" & procedureTraceRoutine & "', 0)"
' Add procedure info to collection for later update
proceduresToUpdate.Add Array(procedureTraceRoutine, vbModuleName, procedureName)
'Increase line count
countLine = startLine + numberLine
Else
countLine = countLine + 1
End If
Loop
End If
Next vbComp
' Insert the MyUpdateTraceNumber Sub line for each procedure
Call MyUpdateProceduresWithTrace(proceduresToUpdate)
' Close connection
Set db = Nothing
' Message show
MsgBox "Initialization of the completed routine Trace", vbInformation, "Info"
'Exit sub
Exit Sub
' Error handler display
ErrorHandler:
MsgBox "Errore: " & Err.Description, vbCritical
' Check connection is closed
If Not db Is Nothing Then Set db = Nothing
End Sub
' INSERT NEW COMMAND LINE PROCEDURE TRACE AND SAVE/EXIT MODULES
Sub MyUpdateProceduresWithTrace(procedures As Collection)
Dim procData As Variant
Dim procedureTraceRoutine As String
Dim vbModuleName As String
Dim procedureName As String
Dim vbModule As VBIDE.codeModule
' Read all procedures and insert new command line
For Each procData In procedures
' retrieve collection values
procedureTraceRoutine = procData(0)
vbModuleName = procData(1)
procedureName = procData(2)
' Set module
Set vbModule = Application.VBE.ActiveVBProject.VBComponents(vbModuleName).codeModule
' Search module and insert newline
Dim i As Long
For i = 1 To vbModule.CountOfLines
If Left(Trim(vbModule.Lines(i, 1)), Len(procedureTraceRoutine)) = procedureTraceRoutine Then
' Insert the MyUpdateTraceNumber call right after the routine declaration
vbModule.InsertLines i + 1, " MyUpdateTraceNumber """ & procedureTraceRoutine & """, """ & vbModuleName & """"
' Exit for
Exit For
End If
Next i
Next procData
' Save and close all objects
MySaveAndCloseObgjFormAndReport
End Sub
'SAVE AND CLOSE ALL OBJECTS FORMS AND REPORTS
Sub MySaveAndCloseObgjFormAndReport()
' Set object db application
Dim obj As AccessObject
Dim db As Object
Set db = Application.CurrentProject
' Save and Close all forms objects
For Each obj In db.AllForms
If obj.IsLoaded Then
' Check if open structure
If Forms(obj.Name).CurrentView = 0 Then
' Save and close
DoCmd.Save acForm, obj.Name
DoCmd.Close acForm, obj.Name
End If
End If
Next obj
' Save and Close all reports objects
For Each obj In db.AllReports
If obj.IsLoaded Then
' Check if open structure
If Reports(obj.Name).CurrentView = 0 Then
' Save and close
DoCmd.Save acReport, obj.Name
DoCmd.Close acReport, obj.Name
End If
End If
Next obj
' Close connection
Set db = Nothing
End Sub
' UPDATE COUNTER INVOKE PROCEDURE
Sub MyUpdateTraceNumber(procedureName As String, traceModule As String)
On Error Resume Next
Dim db As DAO.Database
Set db = CurrentDb
' Increase TraceNumber
db.Execute "UPDATE MyTableTrace SET TraceNumber = TraceNumber + 1 " & _
"WHERE TraceModule = '" & traceModule & "' AND TraceRoutine = '" & procedureName & "'"
' Close
Set db = Nothing
End Sub
' REMOVE ALL TRACE CALLS INTO ROUTINES
Sub MyRemoveUpdateTraceCalls()
Dim vbComp As VBIDE.VBComponent
Dim vbModule As VBIDE.codeModule
Dim i As Long
Dim totalLines As Long
Dim currentLine As String
' Read all modules in the project
For Each vbComp In Application.VBE.ActiveVBProject.VBComponents
' Skip the MyTraceDataAnalysis module
If vbComp.Name <> modCodeTrace Then
' Only process if the component has code
If vbComp.Type = vbext_ct_StdModule Or _
vbComp.Type = vbext_ct_ClassModule Or _
vbComp.Type = vbext_ct_MSForm Or _
vbComp.Type = vbext_ct_Document Then
' Set module obj
Set vbModule = vbComp.codeModule
totalLines = vbModule.CountOfLines
' Read and search from bottom to top
For i = totalLines To 1 Step -1
currentLine = vbModule.Lines(i, 1)
' Check if the line contains MyUpdateTraceNumber
If InStr(1, currentLine, "MyUpdateTraceNumber", vbTextCompare) > 0 Then
' Delete line
vbModule.DeleteLines i
End If
Next i
End If
End If
Next vbComp
' Save and close all objects
MySaveAndCloseObgjFormAndReport
' Message show
MsgBox "Removed all Trace activities in the VBA code", vbInformation, "Info"
End Sub
.
Chiedo venia in quanto l'ho buttato giù un pò velocemente e spero sia comprensibile e privo di errori marchiani ;-)) ma comunque si parla di un codice molto molto banale e semplice e di facile realizzazione... pertanto si raccomanda di fare i dovuti test e validazioni del caso.
In sintesi è venuto fuori un post un pò lungo, ma da leggere attentamente e approfondire metodi e tecniche che possono essere implementate, migliorate, etc....
Del resto non saprei come meglio descrivere un processo di questo tipo, ma sono a completa disposizioni per eventuali spiegazioni, approfondimenti, etc...