Ejemplo de la vida real del uso de conjuntos de registros virtuales en memoria en VBA

La semana pasada presenté el concepto de conjuntos de registros virtuales o en memoria. Estos conjuntos de registros se crean completamente en la memoria y no están vinculados a ninguna fuente de datos, lo que significa que no requieren ninguna operación de E/S.

Si se perdió mi introducción sobre el tema, asegúrese de consultar:

y también

así como

La premisa

Hasta ahora, los ejemplos han sido algo teóricos. Hoy quiero presentar un ejemplo práctico del mundo real de cómo se puede implementar esto en una solución VBA.

El siguiente código se deriva de mi intento inicial en un proyecto reciente en el que pretendía crear un conjunto de registros de archivos dentro de una carpeta. Este enfoque me permite evitar completar tablas innecesariamente, lo que puede provocar una hinchazón no deseada.

Creación de un conjunto de registros virtual de un listado de archivos de directorio

A continuación se muestra un ejemplo de cómo crear un conjunto de registros virtual que incluye todos los archivos de Excel (.xls) ubicados en una carpeta específica.

Sub CreateFileVirtualRecordSet()
    Dim rstVirtual            As Object    'Microsoft ActiveX Data Objects x.x Library
    Dim sFile                 As String
    Dim lCounter              As Long
    Const sPath = "C:\Temp\"

    Set rstVirtual = CreateObject("ADODB.Recordset")
    With rstVirtual
        .Fields.Append "FileId", 20    ' adBigInt
        .Fields.Append "FilePath", 200, 100    ' adVarChar
        .CursorType = 3    ' adOpenStatic
        .CursorLocation = 3    ' adUseClient
        .LockType = 3    ' adLockOptimistic
        .Open
    End With

    sFile = Dir(sPath & "*.xls")
    Do While sFile <> vbNullString
        If sFile <> "." And sFile <> ".." Then
            lCounter = lCounter + 1
            With rstVirtual
                .AddNew
                .Fields("FileId").Value = lCounter
                .Fields("FilePath").Value = sPath & sFile
                .Update
            End With
        End If
        sFile = Dir
    Loop

    'Sort
    rstVirtual.Sort = "FilePath ASC"

    'Filter
    'rstVirtual.Filter = "(FilePath) LIKE '%Temp%'"

    'Assign the recordset to a form to display and work with
    Set Me.Recordset = rstVirtual

    'If rstVirtual.State = 1 Then rstVirtual.Close 'Do NOT DO THIS!!!!
    Set rstVirtual = Nothing
End Sub

Filtrar los datos: una propuesta más complicada

Aquí hay un enfoque alternativo en el que tomamos todos los archivos y luego aplicamos un filtro para usar solo los archivos de Excel. Obviamente, esto es menos eficiente, pero aun así quería demostrarlo, ya que puede ayudar en otros escenarios:

Sub CreateFileVirtualRecordSet()
    Dim rstVirtual            As Object    'Microsoft ActiveX Data Objects x.x Library
    Dim sFile                 As String
    Dim lCounter              As Long
    Const sPath = "C:\Temp\"

    Set rstVirtual = CreateObject("ADODB.Recordset")
    With rstVirtual
        .Fields.Append "FileId", 20    ' adBigInt
        .Fields.Append "FilePath", 200, 100    ' adVarChar
        .CursorType = 3    ' adOpenStatic
        .CursorLocation = 3    ' adUseClient
        .LockType = 3    ' adLockOptimistic
        .Open
    End With

    sFile = Dir(sPath & "*.*")
    Do While sFile <> vbNullString
        If sFile <> "." And sFile <> ".." Then
            lCounter = lCounter + 1
            With rstVirtual
                .AddNew
                .Fields("FileId").Value = lCounter
                .Fields("FilePath").Value = sPath & sFile
                .Update
            End With
        End If
        sFile = Dir
    Loop

    'Filter
    rstVirtual.Filter = "FilePath Like '%.xls%'"

    'Sort
    rstVirtual.Sort = "FilePath ASC"

    'Filter
    'rstVirtual.Filter = "(FilePath) LIKE '%Temp%'"

    'Assign the recordset to a form to display and work with
    Set Me.Recordset = rstVirtual

    'If rstVirtual.State = 1 Then rstVirtual.Close 'Do NOT DO THIS!!!!
    Set rstVirtual = Nothing
End Sub

Ahora, debido a que estamos aplicando un filtro en el conjunto de registros utilizado por el formulario, tenemos que modificar nuestra rutina ProcessRecordSet para aplicar también el mismo filtro o de lo contrario obtendremos el conjunto de registros sin filtrar. Entonces haríamos algo como:

Private Sub ProcessRecordSet()
    Dim rstVirtual            As Object

    Set rstVirtual = Me.Recordset.Clone
    rstVirtual.Filter = Me.Recordset.Filter 'Apply the same filter as that on the form's recordset
    If rstVirtual.State = 1 Then
        Do While Not rstVirtual.EOF
            Debug.Print "File ID: " & rstVirtual.Fields("FileId").Value & ", File Path: " & rstVirtual.Fields("FilePath").Value
            rstVirtual.MoveNext
        Loop
    Else
        MsgBox "Recordset is not open.  We can't work with the data!"
    End If

Cleanup:
    If Not rstVirtual Is Nothing Then
        Set rstVirtual = Nothing
    End If
End Sub

Un ejemplo de formulario completo

Así es como podría verse el código detrás de un formulario.

Private Sub Form_Close()
    Call ProcessRecordSet
End Sub

Private Sub Form_Open(Cancel As Integer)
    Call CreateFileVirtualRecordSet
End Sub


Private Sub CreateFileVirtualRecordSet()
    Dim rstVirtual            As Object    'Microsoft ActiveX Data Objects x.x Library
    Dim sFile                 As String
    Dim lCounter              As Long
    Const sPath = "C:\Temp\"

    Set rstVirtual = CreateObject("ADODB.Recordset")
    With rstVirtual
        .Fields.Append "FileId", 20    ' adBigInt
        .Fields.Append "FilePath", 200, 100    ' adVarChar
        .CursorType = 3    ' adOpenStatic
        .CursorLocation = 3    ' adUseClient
        .LockType = 3    ' adLockOptimistic
        .Open
    End With

    sFile = Dir(sPath & "*.xls")
    Do While sFile <> vbNullString
        If sFile <> "." And sFile <> ".." Then
            lCounter = lCounter + 1
            With rstVirtual
                .AddNew
                .Fields("FileId").Value = lCounter
                .Fields("FilePath").Value = sPath & sFile
                .Update
            End With
        End If
        sFile = Dir
    Loop

    'Sort the recordset
    rstVirtual.Sort = "FilePath ASC"

    'Assign the recordset to the form to display and work with
    Set Me.Recordset = rstVirtual

    Set rstVirtual = Nothing
End Sub

Private Sub ProcessRecordSet()
    Dim rstVirtual            As Object

    Set rstVirtual = Me.Recordset.Clone
    If rstVirtual.State = 1 Then
        Do While Not rstVirtual.EOF
            Debug.Print "File ID: " & rstVirtual.Fields("FileId").Value & ", File Path: " & rstVirtual.Fields("FilePath").Value
            rstVirtual.MoveNext
        Loop
    Else
        MsgBox "Recordset is not open.  We can't work with the data!"
    End If

Cleanup:
    If Not rstVirtual Is Nothing Then
        Set rstVirtual = Nothing
    End If
End Sub

Como puede ver, este enfoque es bastante sencillo de implementar. Al trabajar completamente en la memoria, evitamos saturar tablas innecesariamente y desperdiciar operaciones de E/S, evitando así la sobrecarga.

Por supuesto, esta solución es más adecuada para casos de uso específicos, por lo que es importante evaluar sus requisitos para determinar si se justifica la codificación adicional. Sin embargo, en ciertos escenarios, los conjuntos de registros virtuales en memoria ofrecen ventajas inigualables.