' -----------------------------------------------------------------------------
' 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