Auto code generation

[Laoujin]

Hi everyone,

I am currently making an Access VBA program to help making VBA programs. For this I want to automatically generate code within a function. It should generate error handling - so I need to figure out whether it is a Sub or Function as the error handling contains an Exit Sub/Function clause, as well as the current date as a comment etc.

I tried assigning a ^X hotkey in the autoKeys macro using the InsertLines() function which used to work in Access 2 but apparently the VB Editor and Access are now (Office2003) different environments and the hotkey can no longer be used within the editor.

Ideally this code would be generated as soon as a new function/sub is started or it would be generated by pressing a hotkey.

Any help will be greatly appreciated!

 

[Me!User]

Are you creating an add-in?

It sounds like you are creating an add-in for the VBA IDE, namely a utility to auto-generate the error-handling code for a procedure (sub or function).

I was planning to write a utility to auto-generate the boilerplate of a procedure (documentation comments, error-handling code, etc.) and read articles about creating Add-ins using the Extensibility Object Model. I was spared this task when I discovered a free add-in for the VBA IDE called MZ-Tools V3.0.

MZ-Tools contains many tools to speed code-development including one that lets you add a documentation "header" and an error-handling "footer" to an existing sub or function. It automatically detects the procedure's type and adds "Sub" or "Function" appropriately (i.e. Exit Sub or Exit Function).

Even if this is not precisely what you want, I encourage you to try MS-Tools. I especially like the "Find" tool because it shows you the search results in a treeview ... and "Procedure Callers" shows you (in a treeview) all the subs and functions that call a specified procedure ... and "Analyzer" that shows you all unused variables ... and much more.

 

[Laoujin]

This sounds very promising, I will check it out right away, thanks!

 

[MStCyr]

Here's a set of functions originally developed in Access 97. This code is a set of functions that automatically. Add the error handling code to your functions and Subs.

It has been a while since I've used this but it does work. Has not been tried with Access 2000 and up..

' -----------------------------------------------------------------------------
' Function: CreateProcDefinition(pstrModuleName, pstrProcName, pfSub)
' Purpose: Create standard procedure definition (Function or Sub) with
' error handling code template
' Input: pstrModuleName - Module Name
' pstrProcName - ProcName to create
' pfSub - Sub/Function flag, True - create Sub, False - create function
' MS Access version: Access 97
' -----------------------------------------------------------------------------

Function CreateProcDefinition(pstrModuleName, pstrProcName, pfSub) As Boolean
On Error GoTo CreateProcDefinition_Err
Dim mdl As Module, strFunctionOrSub As String, strText As String
DoCmd.OpenModule pstrModuleName
Set mdl = Modules(pstrModuleName)
strFunctionOrSub = "Function"
If pfSub Then strFunctionOrSub = "Sub"
strText = strFunctionOrSub & " " & pstrProcName & "()" & vbCrLf _
& vbTab & "On Error GoTo " & pstrProcName & "_Err" & vbCrLf _
& "'*+ " & vbCrLf & vbCrLf & "'*-" & vbCrLf _
& pstrProcName & "_Done:" & vbCrLf _
& vbTab & "Exit " & strFunctionOrSub & vbCrLf _
& pstrProcName & "_Err:" & vbCrLf _
& vbTab & "MsgBox """ & pstrProcName & ": "" & Err & "" - "" _
& Err.Description,16" & vbCrLf _
& vbTab & "Resume " & pstrProcName & "_Done" & vbCrLf _
& "End " & strFunctionOrSub
mdl.InsertText strText
CreateProcDefinition = True
CreateProcDefinition_Done:
Exit Function
CreateProcDefinition_Err:
MsgBox Err & ": " & Err.Description
CreateProcDefinition = False
Resume CreateProcDefinition_Done
End Function

' -----------------------------------------------------------------------------
' Function: InsertErrorHandlingCodeTemplate(pstrModuleName, pstrProcName, pfSub)
' Purpose: Insert error handling code template to existing Sub or Function
' Input: pstrModuleName - Module Name
' pstrProcName - ProcName to insert error handling code template to
' pfSub - Sub/Function flag, True - ProcName is Sub, False - ProcName is Function
'
' MS Access version: Access 97
' -----------------------------------------------------------------------------

Function InsertErrorHandlingCodeTemplate(pstrModuleName, pstrProcName, pfSub) As Boolean
Dim mdl As Module, strText As String
Dim strFunctionOrSub As String, lngInsertAt As Long
Dim lngSLine As Long, lngSCol As Long
Dim lngELine As Long, lngECol As Long
Dim fEndOfProcFound As Integer, j As Integer
On Error GoTo InsertErrorHandlingCodeTemplate_Err
DoCmd.OpenModule pstrModuleName
Set mdl = Modules(pstrModuleName)
strFunctionOrSub = "Function"
If pfSub Then strFunctionOrSub = "Sub"
strText = pstrProcName & "_Done:" & vbCrLf _
& vbTab & "Exit " & strFunctionOrSub & vbCrLf _
& pstrProcName & "_Err:" & vbCrLf _
& vbTab & "MsgBox """ & pstrProcName & ": "" & Err & "" - "" & Err.Description,16" & vbCrLf _
& vbTab & "Resume " & pstrProcName & "_Done"
lngSLine = mdl.ProcStartLine(pstrProcName, vbext_pk_Proc)
lngELine = mdl.ProcStartLine(pstrProcName, vbext_pk_Proc) + mdl.ProcCountLines(pstrProcName, vbext_pk_Proc)
' Find method of Module object does not work for last sub/function of module ??? Bug ???
'If mdl.Find("End " & strFunctionOrSub, lngSLine, lngSCol, lngELine, lngECol) Then
' lngInsertAt = lngSLine
'Else
' MsgBox "End line of " & strFunctionOrSub & " " & pstrProcName & " not found !", 16
' GoTo InsertErrorHandlingCodeTemplate_Done
'End If
fEndOfProcFound = False
For j = lngELine To lngSLine Step -1
If InStr(1, mdl.Lines(j, 1), "End " & strFunctionOrSub) Then
lngSLine = j
fEndOfProcFound = True
Exit For
End If
Next j
If fEndOfProcFound = True Then
lngInsertAt = lngSLine
mdl.InsertLines lngInsertAt, strText
strText = vbTab & "On Error GoTo " & pstrProcName & "_Err" ''& vbCrLf
lngInsertAt = mdl.ProcBodyLine(pstrProcName, vbext_pk_Proc) + 1
mdl.InsertLines mdl.ProcBodyLine(pstrProcName, vbext_pk_Proc) + 1, strText
InsertErrorHandlingCodeTemplate = True
End If
InsertErrorHandlingCodeTemplate_Done:
Exit Function
InsertErrorHandlingCodeTemplate_Err:
MsgBox Err & ": " & Err.Description
InsertErrorHandlingCodeTemplate = False
Resume InsertErrorHandlingCodeTemplate_Done
End Function