Private rs As ADODB.Recordset      ' Module-level variable
Sub SetArray(Values As Variant, Fields As Variant)
    Dim row As Long, col As Long
    ' Build a new ADO Recordset.
    If Not (rs Is Nothing) Then
        If rs.Status = adStateOpen Then rs.Close
    End If
    Set rs = New ADODB.Recordset
    ' Create the Fields collection.
    For col = LBound(Fields) To UBound(Fields)
        rs.Fields.Append Fields(col), adBSTR
    Next
    ' Move data from the array to the Recordset.
    rs.Open
    For row = LBound(Values) To UBound(Values)
        rs.AddNew
        For col = 0 To UBound(Values, 2)
            rs(col) = Values(row, col)
        Next
    Next
    rs.MoveFirst
    ' Inform consumers that the data has changed.
    DataMemberChanged ""
End Sub

' Return the Recordset to the data consumer.
Private Sub Class_GetDataMember(DataMember As String, Data As Object)
    Set Data = Recordset
End Sub
' Provides "Safe" access to the Recordset, 
' in that it raises a meaningful error if the Recordset is set to Nothing.
Property Get Recordset() As ADODB.Recordset
    If rs Is Nothing Then
        Err.Raise 1001, , "No data array has been provided"
    Else
        Set Recordset = rs
    End If
End Property

' Partial listing of properties and methods
Public Property Get EOF() As Boolean
    EOF = Recordset.EOF
End Property
Public Property Get BOF() As Boolean
    BOF = Recordset.BOF
End Property
Public Property Get RecordCount() As Long
    RecordCount = Recordset.RecordCount
End Property
Sub MoveFirst()
    Recordset.MoveFirst
End Sub
Sub MovePrevious()
    Recordset.MovePrevious
End Sub
' And so on...

Function GetArray() As Variant
    Dim numFields As Long, row As Long, col As Long
    Dim Bookmark As Variant
    ' Remember the current record pointer.
    Bookmark = Recordset.Bookmark
    
    ' Create the result array, and fill it with data from the Recordset.
    numFields = rs.Fields.Count
    ReDim Values(0 To rs.RecordCount - 1, 0 To numFields - 1) As String
    ' Fill the array with data from the Recordset.
    rs.MoveFirst
    For row = 0 To rs.RecordCount - 1
        For col = 0 To numFields - 1
            Values(row, col) = rs(col)
        Next
        rs.MoveNext
    Next
    GetArray = Values
    ' Restore the record pointer.
    rs.Bookmark = Bookmark
End Function

Dim MyData As New ArrayDataSource           ' Module-level variable
Private Sub Form_Load()
    ReDim Fields(0 To 2) As String           ' Create the Fields array.
    Fields(0) = "ID"
    Fields(1) = "Name"
    Fields(2) = "Department"
    
    ReDim Values(0 To 3, 0 To 2) As String   ' Create the Values array.
    Values(0, 0) = 100                       ' ID field
    Values(0, 1) = "Christine Johnson"       ' Name field
    Values(0, 2) = "Marketing"               ' Department field
    ' Fill other records (omitted...)
    MyData.SetArray Values, Fields           ' Initialize the data source.
    ' Bind the controls.
    Set txtID.DataSource = MyData
    txtID.DataField = "ID"
    Set txtName.DataSource = MyData
    txtName.DataField = "Name"
    Set txtDepartment.DataSource = MyData
    txtDepartment.DataField = "Department"
End Sub

Dim Values() As String
Values = MyData.GetArray()

' In the CEmployee class module
Dim m_FirstName As String

Property Get FirstName() As String
    FirstName = m_FirstName
End Property
Property Let FirstName(ByVal newValue As String)
    If newValue <> m_FirstName Then
        If CanPropertyChange("FirstName") Then
            m_FirstName = newValue
            PropertyChanged "FirstName"
        End If
    End If
End Property

' In the CEmployee class module
Private bndcol As New BindingCollection

Property Get DataSource() As Object
    Set DataSource = bndcol.DataSource
End Property
Property Set DataSource(ByVal newValue As Object)
    Set bndcol = New BindingCollection
    Set bndcol.DataSource = newValue
    bndcol.Add Me, "FirstName", "FirstName", , "FirstName"
    bndcol.Add Me, "LastName", "LastName", , "LastName"
    bndcol.Add Me, "BirthDate", "BirthDate", , "BirthDate"
End Property

Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
Dim employee As New CEmployee
cn.Open "Provider=Microsoft.Jet.OLEDB.3.51;" _
    & "Data Source="C:\Program Files\Microsoft Visual Studio\Vb98\NWind.mdb"
rs.Open "Employees", cn, adOpenKeyset, adLockOptimistic
Set employee.DataSource = rs

Public Property Get DataSource() As DataSource
End Property
Public Property Set DataSource(ByVal objDataSource As DataSource)
End Property

Public Property Get DataMember() As DataMember
End Property
Public Property Let DataMember(ByVal DataMember As DataMember)
End Property

Private WithEvents rs As ADODB.Recordset
Private bndcol As New BindingCollection
Private m_DataMember As String

Public Property Get DataMember() As String
    DataMember = m_DataMember
End Property
Public Property Let DataMember(ByVal newValue As String)
    m_DataMember = newValue
End Property

Public Property Get DataSource() As DataSource
    ' Simply delegate to the Recordset's DataMember property.
    If Not (rs Is Nothing) Then
        Set DataSource = rs.DataSource
    End If
End Property
Public Property Set DataSource(ByVal newValue As DataSource)
    If Not Ambient.UserMode Then Exit Property
    If Not (rs Is Nothing) Then
        ' If the new value equals the old one, exit right now.
        If rs.DataSource Is newValue Then Exit Property
        If (newValue Is Nothing) Then
            ' The Recordset is being closed. (The program is shutting
            ' down.)  Flush the current record.
            Select Case rs.LockType
                Case adLockBatchOptimistic
                    rs.UpdateBatch
                Case adLockOptimistic, adLockPessimistic
                    rs.Update
                Case Else
            End Select
        End If
    End If
    If Not (newValue Is Nothing) Then
        Set rs = New ADODB.Recordset     ' Re-create the Recordset.
        rs.DataMember = m_DataMember
        Set rs.DataSource = newValue
        Refresh                          ' Reload all data.
    End If
End Property

Sub Refresh()
    ' Exit if in design mode.
    If Not Ambient.UserMode Then Exit Sub    
    ' Clear the ListView, and exit if the Recordset is empty or closed.
    ListView1.ListItems.Clear
    If rs Is Nothing Then Exit Sub
    If rs.State <> adStateOpen Then Exit Sub
    ' Move to the first record, but remember the current position.
    Dim Bookmark As Variant, FldName As Variant
    Bookmark = rs.Bookmark
    rs.MoveFirst
    
    ' Load the data from the Recordset into the ListView.
    Do Until rs.EOF
        With ListView1.ListItems.Add(, , rs("ProductName"))
            .ListSubItems.Add , , rs("UnitPrice")
            .ListSubItems.Add , , rs("UnitsInStock")
            .ListSubItems.Add , , rs("UnitsOnOrder")
            ' Remember the Bookmark of this record.
            .Tag = rs.Bookmark
        End With
        rs.MoveNext
    Loop
    ' Restore the pointer to the current record.
    rs.Bookmark = Bookmark
    
    ' Bind the properties to the Recordset.
    Set bndcol = New BindingCollection
    bndcol.DataMember = m_DataMember
    Set bndcol.DataSource = rs
    For Each FldName In Array("ProductName", "UnitPrice", "UnitsInStock", _
        "UnitsOnOrder")
        bndcol.Add Me, FldName, FldName
    Next
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    rs.Bookmark = Item.Tag
End Sub

Private Sub rs_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, _
    ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
    ByVal pRecordset As ADODB.Recordset)
    Dim Item As ListItem
    ' Exit if in a BOF or EOF condition.
    If rs.EOF Or rs.BOF Then Exit Sub
    ' Highlight the item corresponding to the current record.
    For Each Item In ListView1.ListItems
        If Item.Tag = rs.Bookmark Then
            Set ListView1.SelectedItem = Item
            Exit For
        End If
    Next
    ' Ensure that the item is visible.
    If Not (ListView1.SelectedItem Is Nothing) Then
        ListView1.SelectedItem.EnsureVisible
    End If
    ListView1.Refresh
End Sub

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" _
    & "Data Source=C:\Program Files\Microsoft VisualStudio\Vb98\NWind.mdb" 
Adodc1.Refresh
Set ProductGrid1.DataSource = Adodc1

Implements OLEDBSimpleProvider
Const DELIMITER = ";"        ' Change this at will.
Const E_FAIL = &H80004005    ' A typical error code for OLE DB providers

Dim DataArray() As Variant   ' An array of arrays
Dim RowCount As Long         ' Number of rows (records)
Dim ColCount As Long         ' Number of columns (fields)
Dim IsDirty As Boolean       ' True if data has changed
Dim m_FileName As String     ' The path of the data file

Dim Listeners As New Collection
Dim Listener As OLEDBSimpleProviderListener

Sub LoadData(FileName As String)
    Dim fnum As Integer, FileText As String
    Dim records() As String, fields() As String
    Dim row As Long, col As Long

    ' Read the file in memory.
    m_FileName = FileName       ' Remember the file name for later.
    fnum = FreeFile
    On Error GoTo ErrorHandler
    Open m_FileName For Input Lock Read Write As #fnum
    FileText = Input(LOF(fnum), #fnum)
    Close #fnum
    
    ' Split the file into records and fields.
    records = Split(FileText, vbCrLf)
    RowCount = UBound(records)
    ColCount = -1
    ReDim DataArray(0 To RowCount) As Variant
    
    For row = 0 To RowCount
        fields = Split(records(row), DELIMITER)
        DataArray(row) = fields
    Next
    ' The first record sets ColCount.
    ColCount = UBound(DataArray(0)) + 1
    Exit Sub
    
ErrorHandler:
    Err.Raise E_FAIL
End Sub

Sub SaveData()
    Dim fnum As Integer, FileText As String
    Dim records() As String, fields() As String
    Dim row As Long, col As Long
    
    For row = 0 To UBound(DataArray)
        FileText = FileText & Join(DataArray(row), DELIMITER) & vbCrLf
    Next
    ' Drop the last CR-LF character pair.
    FileText = Left$(FileText, Len(FileText) - 2)
    ' Write the file.
    fnum = FreeFile
    On Error GoTo ErrorHandler
    Open m_FileName For Output Lock Read Write As #fnum
    Print #fnum, FileText;
    Close #fnum
    IsDirty = False
    Exit Sub
ErrorHandler:
    Err.Raise E_FAIL
End Sub

' Return the exact number of rows.
Private Function OLEDBSimpleProvider_getRowCount() As Long
    OLEDBSimpleProvider_getRowCount = RowCount
End Function
' Return the number of columns.
Private Function OLEDBSimpleProvider_getColumnCount() As Long
    OLEDBSimpleProvider_getColumnCount = ColCount
End Function

' Return a string that determines the system's international settings
' or an empty string if the provider doesn't support different locales.
' (This one doesn't.)
Private Function OLEDBSimpleProvider_getLocale() As String
    OLEDBSimpleProvider_getLocale = ""
End Function

' Return a nonzero value if the rowset is populated asynchronously.
Private Function OLEDBSimpleProvider_isAsync() As Long
    OLEDBSimpleProvider_isAsync = False
End Function
' Return the estimated number of rows or -1 if unknown.
' This method is used in asynchronous data transfers.
Private Function OLEDBSimpleProvider_getEstimatedRows() As Long
    ' The following statement is for demonstration purposes only because
    ' this method will never be called in this provider.
    OLEDBSimpleProvider_getEstimatedRows = RowCount
End Function
' Stop asynchronous transfer.
Private Sub OLEDBSimpleProvider_stopTransfer()
    ' Do nothing in this provider.
End Sub

' Add a Listener object to the Listeners collection.
Private Sub OLEDBSimpleProvider_addOLEDBSimpleProviderListener( _
    ByVal pospIListener As MSDAOSP.OLEDBSimpleProviderListener)
    If Not (pospIListener Is Nothing) Then Listeners.Add pospIListener
End Sub
' Remove a Listener from the Listeners collection.
Private Sub OLEDBSimpleProvider_removeOLEDBSimpleProviderListener( _
    ByVal pospIListener As MSDAOSP.OLEDBSimpleProviderListener)
    Dim i As Long
    For i = 1 To Listeners.Count
        If Listeners(i) Is pospIListener Then
            Listeners.Remove I
            Exit For
        End If
    Next
End Sub

' Return the read/write status of a value.
Private Function OLEDBSimpleProvider_getRWStatus(ByVal iRow As Long, _
    ByVal iColumn As Long) As MSDAOSP.OSPRW
    ' Make all fields read/write.
    OLEDBSimpleProvider_getRWStatus = OSPRW_READWRITE
End Function

' Read a value at given row and column coordinates.
Private Function OLEDBSimpleProvider_getVariant(ByVal iRow As Long, _
    ByVal iColumn As Long, ByVal format As MSDAOSP.OSPFORMAT) As Variant
    ' Use (iColumn _ 1) because the iColumn parameter is 1-based
    ' whereas values are stored in 0-based string arrays.
    OLEDBSimpleProvider_getVariant = DataArray(iRow)(iColumn - 1)
End Function

' Write a value at given row/column coordinates.
Private Sub OLEDBSimpleProvider_setVariant(ByVal iRow As Long, _
    ByVal iColumn As Long, ByVal format As MSDAOSP.OSPFORMAT, _
    ByVal Var As Variant)
    ' Prenotification
    For Each Listener In Listeners
        Listener.aboutToChangeCell iRow, iColumn
    Next
    DataArray(iRow)(iColumn - 1) = Var
    ' Postnotification
    For Each Listener In Listeners
        Listener.cellChanged iRow, iColumn
    Next
    IsDirty = True
End Sub

' Insert one or more rows.
Private Function OLEDBSimpleProvider_insertRows(ByVal iRow As Long, _
    ByVal cRows As Long) As Long
    Dim row As Long
    ' Validate iRow - (RowCount + 1), and account for AddNew commands.
    If iRow < 1 Or iRow > (RowCount + 1) Then Err.Raise E_FAIL
    ReDim emptyArray(0 To ColCount) As String
    ReDim Preserve DataArray(RowCount + cRows) As Variant

    ' Prenotification
    For Each Listener In Listeners
        Listener.aboutToInsertRows iRow, cRows
    Next
    ' Make room in the array.
    If iRow <= RowCount Then
        For row = RowCount To iRow Step -1
            DataArray(row + cRows) = DataArray(row)
            DataArray(row) = emptyArray
        Next
    Else
        For row = RowCount + 1 To RowCount + cRows
            DataArray(row) = emptyArray
        Next
    End If
    RowCount = RowCount + cRows

    ' Postnotification
    For Each Listener In Listeners
        Listener.insertedRows iRow, cRows
    Next
    ' Return the number of inserted rows.
    OLEDBSimpleProvider_insertRows = cRows
    IsDirty = True
End Function
' Delete one or more rows.
Private Function OLEDBSimpleProvider_deleteRows(ByVal iRow As Long, _
    ByVal cRows As Long) As Long
    Dim row As Long
    ' Validate iRow.
    If iRow < 1 Or iRow > RowCount Then Err.Raise E_FAIL
    ' Set cRows to the actual number, which can be deleted.
    If iRow + cRows > RowCount + 1 Then cRows = RowCount - iRow + 1

    ' Prenotification
    For Each Listener In Listeners
        Listener.aboutToDeleteRows iRow, cRows
    Next
    ' Shrink the array.
    For row = iRow To RowCount - cRows
        DataArray(row) = DataArray(row + cRows)
    Next
    RowCount = RowCount - cRows
    ReDim Preserve DataArray(RowCount) As Variant

    ' Postnotification
    For Each Listener In Listeners
        Listener.deletedRows iRow, cRows
    Next
    ' Return the number of deleted rows.
    OLEDBSimpleProvider_deleteRows = cRows
    IsDirty = True 
End Function

Private Function OLEDBSimpleProvider_Find(ByVal iRowStart As Long, _
    ByVal iColumn As Long, ByVal val As Variant, ByVal findFlags As _
    MSDAOSP.OSPFIND, ByVal compType As MSDAOSP.OSPCOMP) As Long
    Dim RowStop As Long, RowStep As Long
    Dim CaseSens As Long, StringComp As Boolean
    Dim result As Long, compResult As Integer, row As Long
    
    ' Determine the end row and the step value for the loop.
    If findFlags And OSPFIND_UP Then
        RowStop = 1: RowStep = -1
    Else
        RowStop = RowCount: RowStep = 1
    End If
    ' Determine the case-sensitive flag.
    If findFlags And OSPFIND_CASESENSITIVE Then
        CaseSens = vbBinaryCompare
    Else
        CaseSens = vbTextCompare
    End If
    ' True if we're dealing with strings
    StringComp = (VarType(val) = vbString)
    ' -1 means not found.
    result = -1
    ' iColumn is 1-based, but internal data is 0-based.
    iColumn = iColumn - 1
    
    For row = iRowStart To RowStop Step RowStep
        If StringComp Then
            ' We're comparing strings.
            compResult = StrComp(DataArray(row)(iColumn), val, CaseSens)
        Else
            ' We're comparing numbers or dates.
            compResult = Sgn(DataArray(row)(iColumn) - val)
        End If
        Select Case compType
            Case OSPCOMP_DEFAULT, OSPCOMP_EQ
                If compResult = 0 Then result = row
            Case OSPCOMP_GE
                If compResult >= 0 Then result = row
            Case OSPCOMP_GT
                If compResult > 0 Then result = row
            Case OSPCOMP_LE
                If compResult <= 0 Then result = row
            Case OSPCOMP_LT
                If compResult < 0 Then result = row
            Case OSPCOMP_NE
                If compResult <> 0 Then result = row
        End Select
        If result <> -1 Then Exit For
    Next
    ' Return the row found or -1.
    OLEDBSimpleProvider_find = result
End Function

Const E_FAIL = &H80004005
' The DataMember passed to this function is the path of the text file.
Function msDataSourceObject(DataMember As String) As OLEDBSimpleProvider
    ' Raise an error if the member is invalid.
    If DataMember = "" Then Err.Raise E_FAIL
    ' Create an instance of the OLE DB Simple Provider component,
    ' load a data file, and return the instance to the caller.    
    Dim TextOSP As New TextOSP
    TextOSP.LoadData DataMember
    Set msDataSourceObject = TextOSP
End Function
Function addDataSourceListener(ByVal pospIListener As DataSourceListener) _
    As Long
    addDataSourceListener = 0
End Function

REGEDIT4
[HKEY_CLASSES_ROOT\TextOSP_VB]
@="Semicolon-delimited text files"
[HKEY_CLASSES_ROOT\TextOSP_VB\CLSID]
@="{CDC6BD0B-98FC-11D2-BAC5-0080C8F21830}"
[HKEY_CLASSES_ROOT\CLSID\{CDC6BD0B-98FC-11D2-BAC5-0080C8F21830}]
@="TextOSP_VB"
[HKEY_CLASSES_ROOT\CLSID\{CDC6BD0B-98FC-11D2-BAC5-0080C8F21830}\InprocServer32]
@="c:\\Program Files\\Common Files\\System\\OLE DB\\MSDAOSP.DLL"
"ThreadingModel"="Both"
[HKEY_CLASSES_ROOT\CLSID\{CDC6BD0B-98FC-11D2-BAC5-0080C8F21830}\ProgID]
@="TextOSP_VB.1"
[HKEY_CLASSES_ROOT\CLSID\{CDC6BD0B-98FC-11D2-BAC5-
0080C8F21830}\VersionIndependentProgID]
@="TextOSP_VB"
[HKEY_CLASSES_ROOT\CLSID\{CDC6BD0B-98FC-11D2-BAC5-
0080C8F21830}\OLE DB Provider]
@="Semicolon-delimited text files"
[HKEY_CLASSES_ROOT\CLSID\{CDC6BD0B-98FC-11D2-BAC5-
0080C8F21830}\OSP Data Object]
@="TextOLEDBProvider.TextDataSource"

Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
cn.Open "Provider=TextOSP_VB;Data Source=TextOLEDBProvider.TextDataSource"
rs.Open "C:\Employees.Txt", cn, adOpenStatic, adLockOptimistic
rs.MoveFirst
Do Until rs.EOF
    Print rs("FirstName") & " " & rs("LastName")
    rs.MoveNext
Loop
rs.Close
cn.Close