Code Snippets

In all the times I have spent participating in forum discussions about all sorts of users' questions, I have learnt a great deal from all the participants.

I have decided to post some of the sample codes that I found users were asking for almost all the time to help me keep them in one place and to make it easier for me to share them again and again.

Hope you find them useful.



Leigh's Generic DAO and ADO Recordsets

The following functions were from fellow MVP, Leigh Purvis (LPurvis). It automatically evaluates any parameters in your SQL when using the OpenRecordset (DAO) or the Open (ADO) method to avoid getting Run-time error '3061': Too few parameters.

Function fDAOGenericRst(strSQL As String, _
                    Optional intType As DAO.RecordsetTypeEnum = dbOpenDynaset, _
                    Optional intOptions As DAO.RecordsetOptionEnum, _
                    Optional intLock As DAO.LockTypeEnum, _
                    Optional pdb As DAO.Database) As DAO.Recordset
                                          
    Dim db As Database
    Dim qdf As QueryDef
    Dim rst As DAO.Recordset
    Dim prm As DAO.Parameter
    
    If Not pdb Is Nothing Then
        Set db = pdb
    Else
        Set db = CurrentDb
    End If
    
    On Error Resume Next
    Set qdf = db.QueryDefs(strSQL)
    If Err = 3265 Then
        Set qdf = db.CreateQueryDef("", strSQL)
    End If
    On Error GoTo 0
    
    For Each prm In qdf.Parameters
        prm.Value = Eval(prm.Name)
    Next
    
    If intOptions = 0 And intLock = 0 Then
        Set rst = qdf.OpenRecordset(intType)
    ElseIf intOptions > 0 And intLock = 0 Then
        Set rst = qdf.OpenRecordset(intType, intOptions)
    ElseIf intOptions = 0 And intLock > 0 Then
        Set rst = qdf.OpenRecordset(intType, intLock)
    ElseIf intOptions > 0 And intLock > 0 Then
        Set rst = qdf.OpenRecordset(intType, intOptions, intLock)
    End If
    Set fDAOGenericRst = rst
    
    Set prm = Nothing
    Set rst = Nothing
    Set qdf = Nothing
    Set db = Nothing
    
End Function

Function fADOGenericRst(ByVal strSource As String, _
	Optional cnn As ADODB.Connection, _
        Optional pCursorLocation As ADODB.CursorLocationEnum = adUseServer, _
        Optional pCursorType As ADODB.CursorTypeEnum = adOpenKeyset, _
        Optional pLockType As ADODB.LockTypeEnum = adLockOptimistic, _
        Optional pOption As ADODB.ExecuteOptionEnum = -1) As ADODB.Recordset
    
    Dim cmd As New ADODB.Command
    Dim prm As ADODB.Parameter
    
    If cnn Is Nothing Then
        Set cnn = CurrentProject.Connection
    End If
    Set cmd.ActiveConnection = cnn
    
    If Left(strSource, 11) <> "PARAMETERS " And Left(strSource, 7) <> "SELECT " Then
        strSource = "SELECT * FROM [" & strSource & "]"
    End If
    
    cmd.CommandText = strSource
    
    'cmd.Parameters.Refresh 'Is implicit - this is a Jet util so doesn't incur 
    'overhead penalties
    For Each prm In cmd.Parameters
        prm.Value = Eval(prm.name)
    Next
    
    Set fADOGenericRst = New ADODB.Recordset
    With fADOGenericRst
        .CursorLocation = pCursorLocation
        .Open cmd, , pCursorType, pLockType, pOption
    End With
    
    Set prm = Nothing
    Set cmd = Nothing
    
End Function