Option Explicit

   Const strConn = "DSN=Pubs"
   Const strDefaultSQL = "SELECT * FROM Titles"

   Dim cn As ADODB.Connection
   Dim WithEvents rs As ADODB.Recordset

   Private Sub Form_Load()
      Command1.Caption = "Go"
      Text1.Text = strDefaultSQL

      Set cn = New ADODB.Connection
      cn.Open strConn
   End Sub

   Private Sub Command1_Click()
      Dim strSQL As String
      strSQL = Text1.Text

      Set rs = New ADODB.Recordset
      With rs
         .CursorLocation = adUseClient

         .Properties("Initial Fetch Size") = 2
         .Properties("Background Fetch Size") = 4

         Debug.Print "Start"
         Debug.Print "Initial Fetch Size: " & _
                     .Properties("Initial Fetch Size")
         Debug.Print "Background Fetch Size" & _
                     .Properties("Background Fetch Size")

         .Open strSQL, cn, , , adAsyncFetch
      End With
   End Sub

   Private Sub rs_FetchProgress(ByVal Progress As Long, _
                                ByVal MaxProgress As Long, _
                                adStatus As ADODB.EventStatusEnum, _
                                ByVal pRecordset As ADODB.Recordset)

      Debug.Print "Fetch: " & Progress & _
                  "  Max: " & MaxProgress

   End Sub

   Private Sub rs_FetchComplete(ByVal pError As ADODB.Error, _
                                adStatus As ADODB.EventStatusEnum, _
                                ByVal pRecordset As ADODB.Recordset)

      If adStatus <> adStatusOK Then
         Debug.Print "Failed"
         Debug.Print "Error: " & pError.Number & " - " & pError.Description
      Else
         Set DataGrid1.DataSource = pRecordset
         Debug.Print "Done"
      End If

   End Sub