Sytse1
Gebruiker
- Lid geworden
- 9 aug 2007
- Berichten
- 584
- Office versie
- miDer
Geen vraag deze keer maar een code die je veel werk uit handen kan nemen.
Automatische foutafhandeling in Access
Deze code is geschreven in Access 2003 maar werkt uitstekend in mijn Access 2019
De code doet twee dingen geheel automatisch.
1. Het maken van een procedure in Access moet een foutafhandeling hebben.
Tenzij je een een macro converteert met een foutafhandeling moet je de foutafhandeling in elke private sub of functie zelf schrijven.
Wanneer je een nieuwe procedure start, wordt er geen foutafhandeling toegevoegd, je moet dit zelf doen.
Dit is traag, vervelend en herhalend, precies het soort taak dat een computer zou moeten doen.
Deze code doet dit voor jou.
2. Wanneer je een nieuwe module start, hetzij in een formulier of rapport, hetzij in een globale module, verklaart Access standaard Option Explicit niet.
Dit betekent dat een simpele spelfout in de namen van de variabelen schade aan je code kan veroorzaken.
Alle modules moeten de optie expliciet hebben en alle variabelen moeten expliciet worden gedeclareerd.
Deze code zet in alle modules Option Explicit. Als je daarna kiest voor foutopsporing zie wellicht wat nog een Dim moet hebben.
Onderstaande code bevat drie procedures,
Uitvoeren kan starten vanuit het Direct (Ctrl+g) venster met SetAllErrorChecking, of selecteer SetAllErrorChecking en gebruikt de toets F5.
Er wordt dan aan elk stukje code de foutafhandeling toegevoegd en er wordt aan elke module de expliciete optie toegevoegd.
Codeer gewoon zonder de foutafhandeling en voeg dit toe wanneer je dit uitkomt de foutafhandeling toe.
Belangrijk.
De drie procedures moeten alle drie in dezelfde module staan.
Maak, zeker voor de eerste keer,
een back-up voordat je dit uitvoert.
De eerste procedure is SetAllErrorChecking.
Deze is vrij eenvoudig, het loopt door alle modules en roept processmod voor elke module aan.
Het doorloopt vervolgens alle formulieren en rapporten en doet hetzelfde voor elke module die ze bevatten.
De: processmod, neemt een module als parameter.
Eerst de modulenaam en aangenomen wordt dan dat de optie expliciet niet is ingesteld.
Alle regels worden gecheckt tot aan CountOfDeclarationLines op zoek naar een expliciete optie.
Als dit wordt gevonden wordt boolGot ingesteld op true.
Zo niet, dan wordt de Option Explicit in de 2e regel van de module ingevoegd.
Daarna op zoek naar elke procedure. De modulefuncties kunnen niet gebruikt worden omdat ze het mogelijk maken een procedure te starten, met commentaarregels, vóór de eigenlijke Private Sub- of Public Function-instructie.
Er wordt gescant voor elk van de mogelijke startregels van de procedure.
Wanneer die gevonden wordt start processProc, die geeft de procedurenaam, type, startlijn door.
Na de start van ProcessProc wordt in de procedure elke regel gescant op zoek naar On Error. Als het ergens in de procedure On Error vindt, gaat het ervan uit dat je al een foutafhandeling hebt voor dit proces en wordt de procedure genegeert.
Dus als je geen foutafhandeling in een procedure wilt, dan kan je de commentaarregel
' On Error no error handling here invullen. Dan wordt die procedure overgeslagen.
Als we geen foutafhandeling aanwezig is,wordt het volgende toegevoegd.
Na de startlijn On Error Goto xxx_Err toe, waarbij xxx de procedurenaam is
Aan het einde van de procedure worden de volgende regels toegevoegd.
Dit kan worden aangepast aan je eigen foutafhandelingsomstandigheden.
xxx_Exit:
Exit Sub (of Exit Function)
xxx_Err:
MsgBox Err.Description & "in xxx"
Resume xxx_Exit Print tenslotte "added error handling" uit zodat je kan zien wat er is toegevoegd als alles is gedaan.
Dus kopieer de code, open het directe venster, typ SetAllErrorChecking en geniet van
De code is vrij van rechten en mag aangepast worden en zonder vermeldingen gebruikt worden.
Voor deze code wordt Mark Fisher geweldig bedankt.
Automatische foutafhandeling in Access
Deze code is geschreven in Access 2003 maar werkt uitstekend in mijn Access 2019
De code doet twee dingen geheel automatisch.
1. Het maken van een procedure in Access moet een foutafhandeling hebben.
Tenzij je een een macro converteert met een foutafhandeling moet je de foutafhandeling in elke private sub of functie zelf schrijven.
Wanneer je een nieuwe procedure start, wordt er geen foutafhandeling toegevoegd, je moet dit zelf doen.
Dit is traag, vervelend en herhalend, precies het soort taak dat een computer zou moeten doen.
Deze code doet dit voor jou.
2. Wanneer je een nieuwe module start, hetzij in een formulier of rapport, hetzij in een globale module, verklaart Access standaard Option Explicit niet.
Dit betekent dat een simpele spelfout in de namen van de variabelen schade aan je code kan veroorzaken.
Alle modules moeten de optie expliciet hebben en alle variabelen moeten expliciet worden gedeclareerd.
Deze code zet in alle modules Option Explicit. Als je daarna kiest voor foutopsporing zie wellicht wat nog een Dim moet hebben.
Onderstaande code bevat drie procedures,
Uitvoeren kan starten vanuit het Direct (Ctrl+g) venster met SetAllErrorChecking, of selecteer SetAllErrorChecking en gebruikt de toets F5.
Er wordt dan aan elk stukje code de foutafhandeling toegevoegd en er wordt aan elke module de expliciete optie toegevoegd.
Codeer gewoon zonder de foutafhandeling en voeg dit toe wanneer je dit uitkomt de foutafhandeling toe.
Belangrijk.
De drie procedures moeten alle drie in dezelfde module staan.
Maak, zeker voor de eerste keer,
Code:
De eerste procedure is SetAllErrorChecking.
Deze is vrij eenvoudig, het loopt door alle modules en roept processmod voor elke module aan.
Het doorloopt vervolgens alle formulieren en rapporten en doet hetzelfde voor elke module die ze bevatten.
De: processmod, neemt een module als parameter.
Eerst de modulenaam en aangenomen wordt dan dat de optie expliciet niet is ingesteld.
Alle regels worden gecheckt tot aan CountOfDeclarationLines op zoek naar een expliciete optie.
Als dit wordt gevonden wordt boolGot ingesteld op true.
Zo niet, dan wordt de Option Explicit in de 2e regel van de module ingevoegd.
Daarna op zoek naar elke procedure. De modulefuncties kunnen niet gebruikt worden omdat ze het mogelijk maken een procedure te starten, met commentaarregels, vóór de eigenlijke Private Sub- of Public Function-instructie.
Er wordt gescant voor elk van de mogelijke startregels van de procedure.
Wanneer die gevonden wordt start processProc, die geeft de procedurenaam, type, startlijn door.
Na de start van ProcessProc wordt in de procedure elke regel gescant op zoek naar On Error. Als het ergens in de procedure On Error vindt, gaat het ervan uit dat je al een foutafhandeling hebt voor dit proces en wordt de procedure genegeert.
Dus als je geen foutafhandeling in een procedure wilt, dan kan je de commentaarregel
' On Error no error handling here invullen. Dan wordt die procedure overgeslagen.
Als we geen foutafhandeling aanwezig is,wordt het volgende toegevoegd.
Na de startlijn On Error Goto xxx_Err toe, waarbij xxx de procedurenaam is
Aan het einde van de procedure worden de volgende regels toegevoegd.
Dit kan worden aangepast aan je eigen foutafhandelingsomstandigheden.
xxx_Exit:
Exit Sub (of Exit Function)
xxx_Err:
MsgBox Err.Description & "in xxx"
Resume xxx_Exit Print tenslotte "added error handling" uit zodat je kan zien wat er is toegevoegd als alles is gedaan.
Dus kopieer de code, open het directe venster, typ SetAllErrorChecking en geniet van
De code is vrij van rechten en mag aangepast worden en zonder vermeldingen gebruikt worden.
Voor deze code wordt Mark Fisher geweldig bedankt.
Code:
Option Compare Database
Option Explicit
Sub SetAllErrorChecking()
'Opent alle code en plaatst een error check
Dim cont As Container
Dim mdl As Module
Dim doc As Document
Set cont = DBEngine(0)(0).Containers("Modules")
For Each doc In cont.Documents
If doc.Name <> "basManualFunctions" Then
DoCmd.OpenModule doc.Name
Set mdl = Modules(doc.Name)
processmod mdl
DoCmd.Close acModule, doc.Name, acSaveYes
End If
Next doc
Dim i As Integer, j As Integer
Dim db As Database
Dim frm As Form, rpt As Report
Set db = CurrentDb
For i = 0 To db.Containers.Count - 1
If db.Containers(i).Name = "Forms" Then
For j = 0 To db.Containers(i).Documents.Count - 1
DoCmd.OpenForm db.Containers(i).Documents(j).Name, acDesign
Set frm = Forms(db.Containers(i).Documents(j).Name)
processmod frm.Module
DoCmd.Close acForm, db.Containers(i).Documents(j).Name, acSaveYes
Next
End If
If db.Containers(i).Name = "Reports" Then
For j = 0 To db.Containers(i).Documents.Count - 1
DoCmd.OpenReport db.Containers(i).Documents(j).Name, acDesign
Set rpt = Reports(db.Containers(i).Documents(j).Name)
processmod rpt.Module
DoCmd.Close acReport, db.Containers(i).Documents(j).Name, acSaveYes
Next
End If
Next
Set db = Nothing
Set mdl = Nothing
Set doc = Nothing
Set cont = Nothing
End Sub
Sub processmod(mdl As Module)
Dim intLine As Long, strLine As String, strProcName As String, intBrac As Integer
Dim boolGot As Boolean
Debug.Print mdl.Name
boolGot = False
For intLine = 1 To mdl.CountOfDeclarationLines
strLine = mdl.Lines(intLine, 1)
If Trim(strLine) = "Option Explicit" Then boolGot = True
Next
If Not boolGot Then
mdl.InsertLines 2, "Option Explicit"
Debug.Print " Added Option Explicit"
End If
intLine = 0
While intLine < mdl.CountOfLines - 1
intLine = intLine + 1
strLine = mdl.Lines(intLine, 1)
If Left(strLine, 3) = "Sub" Then
'een nieuwe Sub Routing
strProcName = Right(strLine, Len(strLine) - 4)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Sub", mdl
End If
If Left(strLine, 10) = "Public Sub" Then
'een nieuwe Sub Routing
strProcName = Right(strLine, Len(strLine) - 11)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Sub", mdl
End If
If Left(strLine, 11) = "Private Sub" Then
'een nieuwe Sub Routing
strProcName = Right(strLine, Len(strLine) - 12)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Sub", mdl
End If
If Left(strLine, 8) = "Function" Then
'een nieuwe Sub Routing
strProcName = Right(strLine, Len(strLine) - 9)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Function", mdl
End If
If Left(strLine, 15) = "Public Function" Then
'een nieuwe Function Routing
strProcName = Right(strLine, Len(strLine) - 16)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Function", mdl
End If
If Left(strLine, 16) = "Private Function" Then
'een nieuwe Function Routing
strProcName = Right(strLine, Len(strLine) - 17)
intBrac = InStr(strProcName, "(")
strProcName = Left(strProcName, intBrac - 1)
processProc strProcName, intLine, "Function", mdl
End If
Wend
End Sub
Sub processProc(ByVal strProcName As String, ByVal intStartLine As Long, ByVal strSubFunc As String, ByRef mdl As Module)
Dim intThisLine As Integer, boolGot As Boolean, intLastLine As Integer, strText As String
boolGot = False
intThisLine = intStartLine
While mdl.Lines(intThisLine, 1) <> "End " & strSubFunc
intThisLine = intThisLine + 1
If InStr(mdl.Lines(intThisLine, 1), "On Error") > 0 Then boolGot = True
Wend
intLastLine = intThisLine
If Not boolGot Then
Debug.Print " " & strProcName
strText = strProcName & "_Exit:" & vbCrLf
strText = strText & " Exit " & strSubFunc & vbCrLf
strText = strText & strProcName & "_Err:" & vbCrLf
strText = strText & " MsgBox Err.Description & " & Chr(34) & " in " & strProcName & Chr(34) & vbCrLf
strText = strText & " Resume " & strProcName & "_Exit"
mdl.InsertLines intLastLine, strText
mdl.InsertLines intStartLine + 1, "On Error Goto " & strProcName & "_Err"
Debug.Print " Added Error Handling"
End If
End Sub
