Public Sub LoadRecords()
    Dim rst As ADODB.Recordset
    Dim cnn As String
    cnn = "Connection String data"
   
    Set rst = GetRstFromSQL(cnn, "Select Id, Name From Area")
   
   
    If Not rst.EOF Then rst.MoveFirst
       Do While Not rst.EOF
           MyList.AddItem rst!Name
           MyList.ItemData(MyList.NewIndex) = rst!Id
           rst.MoveNext
    Loop
   
End Sub

Private Sub GetRecordButton_Click()
    'Προσοχή δεν έχω βάλει error Handling, αν δεν υπαρχει το Id βγάζει Exception.
    Dim SelectedItemData As Long
    SelectedItemData = MyList.ItemData(MyList.ListIndex)
   
    Dim rst As ADODB.Recordset
    Dim cnn As String
    cnn = "Connection String data"
   
    Set rst = GetRstFromSQL(cnn, "Select Id, Name, zipcode From Area where Id=" & SelectedItemData)
    Dim frm As AreaForm
    Set frm = New AreaForm
    frm.Datasource rst  ' H datasource είναι μία ρουτίνα  στην φόρμα AreaForm > Public Sub SetDatasource(area As Recordset)
    frm.Show
End Sub

'Ρουτίνα που επιστρέφει ADODB.Recordset
'Παίρνει δύο παραμέτρους 1. ConnectionString  και 2. το το Sql ερώτημα προς την βάση.
Public Function GetRstFromSQL(ConnectionString As String, strSQL As String) As ADODB.Recordset
   On Error GoTo Handle_Err
  
  Dim cnn As ADODB.Connection
  Dim rst As ADODB.Recordset
  Set cnn = New ADODB.Connection
  cnn.ConnectionString = ConnectionString
  cnn.Open
  If Not cnn.State = adStateOpen Then
      GoTo Exit_Here
  End If
 
   Set rst = New ADODB.Recordset
   With rst
       .CursorLocation = adUseClient
       .LockType = adLockReadOnly
       .CursorType = adOpenStatic
       Set .ActiveConnection = cnn
       .Source = strSQL
       .Open
       Set .ActiveConnection = Nothing
  End With
 
   Set GetRstFromSQL = rst
   Set rst = Nothing
Exit_Here:
  If Not cnn Is Nothing Then
      If cnn.State = adStateOpen Then
          cnn.Close
      End If
      Set cnn = Nothing
  End If
  Exit Function
Handle_Err:
  Select Case Err.Number
    Case Else
        MsgBox (Err.Description)
  End Select
  Resume Exit_Here
  Resume
End Function