Utility to Build VB Class to Match SQL Stored Procedures

It's been my experience that it quickly becomes very confusing when writing code that generates other code. The full text of the code generation function is listed below and comments are interspersed to help the reader understand what's happening. Some of the key lines of code will be described in more detail below.

First, alter creating a StoredProcedure object from SQL DMO, you can loop through all procs by using a For Each loop with the Database object we created earlier. The For Each loop ensures that we will examine each stored proc of the database exactly once.

    Dim oSP As SQLDMO.StoredProcedure
    For Each oSP In oCurDB.StoredProcedures
       ' Do stuff

    Next

    Dim qryResults As SQLDMO.QueryResults
    Set qryResults = oSP.EnumParameters()

	name        name         length  colid   output
	---------   ---------    -----   -----   ----- 
	@TableName  varchar        75      1       0     
	@HowMany    int             4      2       0     
	@NextCount  int             4      3       1     

Public Function Exec_ems_GetNextCounters(ByVal strConnect As String,  _ 
        ByVal strTableName As String, ByVal lngHowMany As Long,  _ 
        ByRef lngNextCounter As Long ) As ADODB.Recordset

    cnn.Open strConnect
    Set com.ActiveConnection = cnn

    With com

        .CommandText = "ems_GetNextCounters"
        .CommandType = adCmdStoredProc

        .Parameters.Append .CreateParameter("RETURN_VALUE", adInteger, adParamReturnValue, , 0)
        .Parameters.Append .CreateParameter("@TableName", adVarChar, adParamInput, 75, strTableName)
        .Parameters.Append .CreateParameter("@HowMany", adInteger, adParamInput, 8, lngHowMany)
        .Parameters.Append .CreateParameter("@NextCounter", adInteger, adParamOutput, 8, lngNextCounter)

        Set rsLocal = .Execute(lngRecordsAffected)
        
        ' In order to return OUTPUT params, the recordset must be closed
        ' So, first save rsLocal to an XML File to reload later
        rsLocal.Save "Temp.xml", adPersistXML
        Set rsLocal = Nothing
        
        lngNextCounter = .Parameters("@NextCounter")

        Set Exec_ems_GetNextCounters = New ADODB.Recordset
        Exec_ems_GetNextCounters.Open "Temp.xml"
        Kill "Temp.xml"

        strSQL7Error = Err.Description

    End With

    Set com.ActiveConnection = Nothing
    Set cnn = Nothing

Conclusion

As you can imagine, there are many details to the formation of the above code. As time and space do not permit me to give a detailed explanation of each line of code, I leave it to the reader to pursue the details to the extent you desire. The sample code will work for you so long as you have the SQL DMO and SQL NS libraries installed on your computer. According to Microsoft, this can be done by registering the redistributable libraries, but I've never been able to get that to work. The safest approach is to simply install SQL Server tools on your development machine. The odds are that if you are developing an application requiring SQL Server Stored Procs, you probably already have the tools installed and these libraries properly registered.

Utilities like this can be a great time saver. I thoroughly expect that some readers will immediately see ways to improve upon the above design. As I stated before, I welcome suggestions and ideas that will make this utility even more powerful and useful.

Full Source Code for CreateCodeFromStoredProcs() Function

' ****************** BEGIN CODE HERE ******************
Public Function CreateCodeFromStoredProcs() As String
On Error Resume Next

Dim oSP As SQLDMO.StoredProcedure
Dim qryResults As SQLDMO.QueryResults

Dim sUserRequestedSP As String
Dim sProcName As String
Dim fContinue As Boolean
Dim sPrefix As String

Dim sGenDeclare As String
Dim sInstrForUse As String

Dim sOpenADO As String
Dim sCloseADO As String
Dim sComment As String
Dim sDeclare As String
Dim sCreateRecordset As String
Dim sVBArguments As String
Dim sByValRef As String
Dim sAssignOUTPUTParam As String
Dim sAppendParams As String
Dim sFnReturnType As String
Dim sExecute As String
Dim sCodeText As String
Dim sReturn As String

Dim i As Integer
Const q = """"
Dim strMsg As String
Dim iLastLineContinuation As Integer

Dim sSQLParamName As String
Dim sVBVariableName As String

Dim sSQLParamType As String
Dim sVBVariableType As String
Dim sADOParamType As String

Dim sSQLParamSize As String
Dim sVBVariableSize As String
Dim sADOParamSize As String

Dim sSQLOutput As String
Dim sADOOutput As String
    
    ' Reset variables
    sComment = ""
    iProcsProcessed = 0
    fFoundProc = False
    
    sInstrForUse = "' ----- BEGIN ASP/ADO CODE USE EXAMPLE FOR THIS CLASS-----" & vbCrLf _
                 & "'" & vbCrLf _
                 & "'  This code may be tweaked and pasted into your ASP Page to instantiate" & vbCrLf _
                 & "'  the class that calls your Stored Proc." & vbCrLf _
                 & "'  You will need to change the names of the DLL, Class and functions as " & vbCrLf _
                 & "'  well as the parameters for the connection string." & vbCrLf _
                 & "'" & vbCrLf _
                 & "'" & vbCrLf _
                 & "'    Dim objDataCls" & vbCrLf _
                 & "'    Dim rstReturn" & vbCrLf _
                 & "'    Dim sConnect" & vbCrLf _
                 & "'    Dim lRecCount" & vbCrLf _
                 & "'    Dim sError" & vbCrLf & vbCrLf _
                 & "'    Set objDataClass = Server.CreateObject(" & q & "YourDLL.YourClass" & q & ")" & vbCrLf _
                 & "'    Set rstReturn = Server.CreateObject(" & q & "ADODB.Recordset" & q & ")" & vbCrLf _
                 & "'    sConnect = " & q & "Provider=SQLOLEDB.1;User ID=sa;PWD=;Initial Catalog=YourDB;Data Source=YourServer" & q & vbCrLf _
                 & "'    Set rstReturn = objDataCls.Exec_ems_MyProc(sConnect, Param_1, ... Param_n)" & vbCrLf _
                 & "'" & vbCrLf _
                 & "'    lRecCount = objDataCls.RecordsAffected" & vbCrLf _
                 & "'    sError = objDataCls.SQLError" & vbCrLf _
                 & "'" & vbCrLf _
                 & "'    If Not rstReturn.BOF Then" & vbCrLf _
                 & "'        Do Until rstReturn.EOF ..." & vbCrLf _
                 & "'" & vbCrLf _
                 & "' ------------------- END CODE SAMPLE ------------------- " & vbCrLf & vbCrLf


    ' Set the variables that will determine what is returned

    ' by the function (based on user selection)
    If chkReturnRecordset = Checked Then
        sFnReturnType = "ADODB.Recordset"
        sCreateRecordset = vbCrLf & "Dim rsLocal As ADODB.Recordset"
    Else
        sFnReturnType = "Long"
        sCreateRecordset = ""
    End If

    
    ' Declare the RecordsAffected and SQL Error variables and create
    ' Property Get functions for them (They are Read-Only)
    sGenDeclare = "Option Explicit" & vbCrLf & vbCrLf & sInstrForUse _
                & "Private lngRecordsAffected As Long" & vbCrLf _
                & "Private strSQL7Error As String" & vbCrLf & vbCrLf _
                & "Property Get RecordsAffected() As String" & vbCrLf _
                & "    RecordsAffected = lngRecordsAffected" & vbCrLf _
                & "End Property" & vbCrLf & vbCrLf _
                & "Property Get SQLError() As String" & vbCrLf _
                & "    SQLError = strSQL7Error" & vbCrLf _
                & "End Property" & vbCrLf & vbCrLf

    ' Declare and Open ADO Connection and Command Objects

    sOpenADO = "On Error Resume Next" & vbCrLf & vbCrLf _
             & "Dim cnn As New ADODB.Connection" & vbCrLf _
             & "Dim com As New ADODB.Command" & sCreateRecordset & vbCrLf & vbCrLf _
             & "    cnn.Open strConnect" & vbCrLf _
             & "    Set com.ActiveConnection = cnn" & vbCrLf & vbCrLf _
             & "    With com" & vbCrLf & vbCrLf

    ' Close the ADO Connection and Command Objects

    sCloseADO = "        strSQL7Error = Err.Description" & vbCrLf & vbCrLf _
              & "    End With" & vbCrLf & vbCrLf _
              & "    Set com.ActiveConnection = Nothing" & vbCrLf _
              & "    Set cnn = Nothing" & vbCrLf & vbCrLf _
              & "End Function" & vbCrLf & vbCrLf
              
   
    ' Check to see if user has entered name of specific

    ' Stored Proc to process.  If so, save to variable
    If chkProcessOnlyOneSP = Checked Then
        sUserRequestedSP = txtStoredProcToProcess
    End If
    
    ' Loop through all Stored Procs, processing only
    ' those matching user defined filter.
    For Each oSP In oCurDB.StoredProcedures
        ' Reset flag   Assume Success
        fContinue = True
        
        ' Capture name of Current Stored Procedure
        sProcName = oSP.Name
        
        ' If the user has not entered the name of a specific
        ' Proc to process, AND has asked that System Procs be
        ' excluded, then test the Proc Name for Sys Prefix.

        If sUserRequestedSP = "" And chkFilter = Checked Then
            ' Capture the Proc 3-letter prefix
            sPrefix = Left(sProcName, 3)
            
            ' Toggle the Continue Flag OFF for Sys Prefix
            If sPrefix = "dt_" Or sPrefix = "sp_" Then fContinue = False
        End If
        
        ' Now toggle Continue Flag OFF is user selected specific proc ...
        If Len(sUserRequestedSP) Then
            ' ... but this one isn't it!
            If LCase(sUserRequestedSP) <> LCase(sProcName) Then fContinue = False
        End If
        
        If fContinue Then
            ' Set counter to indicate that number of procs
            ' processed.  (Will determine finish message.)
            fFoundProc = True
            iProcsProcessed = iProcsProcessed + 1
            lGetTickCountEnd = GetTickCount
            lTics = (lGetTickCountEnd - lGetTickCountStart) / 1000

            lblMsg.Caption = "Processing Proc Number " & iProcsProcessed & "  (Total of " & lTics & " seconds)"
            Me.Refresh
            
            sComment = "'//////////// Code for:  " & sProcName & " ////////////" & vbCrLf
            sComment = sComment & "'  Created on " & Date & vbCrLf
            sComment = sComment & "'  Created by Danny Lesandrini" & vbCrLf
            sComment = sComment & "'  Created for Dean Evans and Associates, Inc." & vbCrLf & "'" & vbCrLf
            sComment = sComment & "'  Parameters expected by this Stored Proc" & vbCrLf & "'  " & String(40, "-") & vbCrLf
            
            sDeclare = "Public Function Exec_" & sProcName & "(ByVal strConnect As String, "
                     
            sCodeText = "        .CommandText = " & q & sProcName & q & vbCrLf _
                      & "        .CommandType = adCmdStoredProc" & vbCrLf & vbCrLf _
                      & "        .Parameters.Append .CreateParameter(" & q & "RETURN_VALUE" & q & ", adInteger, adParamReturnValue, , 0)" & vbCrLf


            
            Set qryResults = oSP.EnumParameters()
            With qryResults
                For i = 1 To qryResults.Rows
                    ' Get Parameter and Variable Name

                    sSQLParamName = .GetColumnString(i, 1)
                    sSQLParamType = " " & .GetColumnString(i, 2)
                    sVBVariableName = GetVBPrefix(Trim(sSQLParamType)) & Mid(sSQLParamName, 2)
                    
                    ' Get Parameter and Variable (VB and ADO) Type
                    sVBVariableType = GetVBVariableType(sSQLParamType)
                    sADOParamType = GetADOParamType(sSQLParamType)
                    
                    ' Get Parameter and Variable (VB and ADO) Size
                    sSQLParamSize = ""
                    sVBVariableSize = .GetColumnString(i, 3)
                    If InStr(1, sSQLParamType, "char") Then sSQLParamSize = "(" & sVBVariableSize & ")"
                    sADOParamSize = GetADOParamSize(sSQLParamType, sVBVariableSize)
                    
                    ' Initialize Variables effected by INPUT/OUTPUT status
                    sSQLOutput = ""
                    sByValRef = "ByVal "
                    sADOOutput = ", adParamInput"
                    
                    ' Determine if Param Type is OUTPUT and reset variables accordingly

                    If .GetColumnString(i, 5) = 1 Then
                        sSQLOutput = " OUTPUT"
                        sADOOutput = ", adParamOutput"
                        sByValRef = "ByRef "
                        sAssignOUTPUTParam = sAssignOUTPUTParam & Space(8) & sVBVariableName & " = .Parameters(" & q & sSQLParamName & q & ")" & vbCrLf

                    End If
                    
                    sComment = sComment & "'    " & sSQLParamName & sSQLParamType & sSQLParamSize & sSQLOutput & vbCrLf
                    
                    ' To avoid the need to scroll right to read the entire Function Declaration

                    ' and Argument List, line continuations will be added ever 60 characters
                    iLastLineContinuation = LastInStr(sVBArguments, "_")
                    If Len(Mid(sVBArguments, iLastLineContinuation)) > 60 Then sVBArguments = sVBArguments & " _ " & vbCrLf & Space(8)
                    
                    sVBArguments = sVBArguments & sByValRef & sVBVariableName & sVBVariableType
                    sAppendParams = sAppendParams & "        .Parameters.Append .CreateParameter(" & q _
                                          & sSQLParamName & q & sADOParamType & sADOOutput _
                                          & sADOParamSize & sVBVariableName & ")" & vbCrLf
                Next
            End With
            
            sDeclare = sDeclare & sVBArguments
            sDeclare = Left(sDeclare, (Len(sDeclare) - 2)) & " ) As " & sFnReturnType & vbCrLf & vbCrLf
            

            ' There is a bug with ADO that requires a recordset be closed prior to
            ' attempting to read OUTPUT parameters.  Since it's not known if the SP
            ' contains a populated recordset, simply persist rsLocal as XML, read the
            ' OUTPUT params, and then reload the XML file into the Return Recordset
            
            If chkReturnRecordset = Checked Then
                sExecute = Space(8) & "Set rsLocal = .Execute(lngRecordsAffected)" & vbCrLf _
                         & Space(8) & "' In order to return OUTPUT params, the recordset must be closed" & vbCrLf _
                         & Space(8) & "' So, first save rsLocal to an XML File to reload later" & vbCrLf _
                         & Space(8) & "rsLocal.Save " & q & "Temp.xml" & q & ", adPersistXML" & vbCrLf _
                         & Space(8) & "Set rsLocal = Nothing" & vbCrLf & vbCrLf _
                         & Space(8) & "Set Exec_" & sProcName & " = New ADODB.Recordset" & vbCrLf & vbCrLf _
                         & Space(8) & "Exec_" & sProcName & ".Open " & q & "Temp.xml" & q & vbCrLf _
                         & Space(8) & "Kill " & q & "Temp.xml" & q & vbCrLf & vbCrLf
            Else
            ' If Return Type is not Recordset, then there are no problems accessing OUTPUT Params

                sExecute = "        .Execute(lngRecordsAffected)" & vbCrLf _
                         & "        Exec_" & sProcName & " = lngRecordsAffected" & vbCrLf
            End If
            
            ' Prepare strings for concatonation
            sCodeText = sCodeText & sAppendParams & vbCrLf & sExecute
            sComment = sComment & "'  " & String(40, "-") & vbCrLf & vbCrLf
            sAssignOUTPUTParam = sAssignOUTPUTParam & vbCrLf
            
            ' Return neatly formatted code text

            sReturn = sReturn & vbCrLf & sComment & sDeclare & sOpenADO & sCodeText & sAssignOUTPUTParam & sCloseADO
            
            ' Reset Variables
            sComment = ""
            sDeclare = ""
            sCodeText = ""
            sAppendParams = ""
            sExecute = ""
            sVBArguments = ""
            sAssignOUTPUTParam = vbCrLf
        End If
    Next
    
    Set oSP = Nothing
    
    Select Case iProcsProcessed
        Case 0
            strMsg = "Error.  No Procs Processed"
        Case 1
            strMsg = "Finished!  Procedure " & sUserRequestedSP & " was processed."
        Case Else
            strMsg = "Finished!  All " & iProcsProcessed & " have been processed."
    End Select
    
    lblMsg.Caption = strMsg
    Me.Refresh

    sReturn = sGenDeclare & sReturn
    CreateCodeFromStoredProcs = sReturn

End Function

' ****************** END CODE HERE ******************