Yo utilizo esta función, prueba si te funciona
'Llamada a la función
uctTotalReg.text = LoadGrid(cSQLGrid, MSFGrid, mdb)
'Código de la función
Public Function LoadGrid(strSQL As String, Grid As MSFlexGrid, gDB As Database, _
Optional bVisuMens, Optional bAdd, _
Optional frmVentana) As Integer
'
' strSQL --> Frase Sql
' Grid --> MSFlexGrid
' gDB --> Base de Datos
' bVisuMens --> Si es true se visualica el mensaje de que no se han encontrado
' registros y si es False no lo visualica.
' bAdd --> Si es true se añade una linea en blanco en el Grid.
' frmVentana --> Es el Nombre de la VENTANA PADRE. En la ventana padre tiene que
' existir la Function rutina con la etiqueta ControlReg.
' A esta rutina se envia el Recordset y la rutina devuelve un true o
' false segun si se quiere visualizar o no el registro.
'
Dim sVal As String
Dim sbuffer, cMensaje As String
Dim iCont As Long, iFixed As Long, OutLen As Long
Dim iRows As Integer
Dim bExisteReg, bControl, bOk As Boolean
Dim rRes As Recordset
Dim i As Integer
If IsMissing(bAdd) Then bAdd = False
If IsMissing(bVisuMens) Then bVisuMens = True
If IsMissing(frmVentana) Then
bControl = False
bOk = True
Else
bControl = True
End If
On Error GoTo GestError
'Poner el cursor a reloj y no repintar el grid
Grid.MousePointer = flexHourglass
Grid.Redraw = False
' Ejecutar frase SQL
If Not CSalir Then
Set rRes = gDB.OpenRecordset(strSQL)
'Eliminar filas del grid
iFixed = Grid.FixedRows
If Not bAdd Then
If iFixed > 0 Then
Grid.Rows = iFixed + 1
Else
Grid.Rows = 1
End If
End If
'Obtener datos del grid
iCont = 1
bExisteReg = False
Do While Not rRes.EOF
sVal = ""
If bControl Then
bOk = frmVentana.ControlReg(rRes)
End If
If bOk Then
For i = 0 To rRes.Fields.Count - 1
If rRes.Fields(i).Type = dbBoolean Then
If rRes.Fields(i) = True Then
sVal = sVal + "SI" + Chr(9)
ElseIf rRes.Fields(i) = False Then
sVal = sVal + "NO" + Chr(9)
End If
Else
If IsNumeric(rRes.Fields(i)) Or IsDate(rRes.Fields(i)) Then
sVal = sVal + CStr(rRes.Fields(i)) + Chr(9)
Else
If IsNull(rRes.Fields(i)) Then
sVal = sVal + Chr(9)
Else
sVal = sVal + rRes.Fields(i) + Chr(9)
End If
End If
End If
Next i
iRows = 1
sbuffer = sbuffer + sVal + vbCr
iCont = iCont + iRows
bExisteReg = True
End If
rRes.MoveNext
Loop
'Si se han obtenido datos se carga el Grid
If (iCont > 1) Then
If bAdd Then
Dim iActualNum As Long
iActualNum = Grid.Rows
Grid.Rows = iActualNum + iCont - 1
Grid.Row = iActualNum
Else
Grid.Rows = iFixed + iCont - 1
Grid.Row = iFixed
End If
Grid.col = 0
Grid.RowSel = Grid.Rows - 1
Grid.ColSel = Grid.Cols - 1
Grid.Clip = sbuffer
Grid.RowSel = iFixed
If iFixed Then Grid.RowHeight(iFixed) = Grid.RowHeight(0)
Else
If Not bAdd Then Grid.RowHeight(iFixed) = 0
End If
' Grid.Row = Grid.RowSel
' If Grid.Rows > Grid.FixedRows Then
' Grid.Rows = iFila
' Grid.RowHeight(Grid.FixedRows) = 240
' Grid.Row = 1
' Grid.RowSel = 1
' Grid.Col = 0
' Grid.ColSel = Grid.Cols - 1
' Else
' Grid.RowHeight(Grid.FixedRows) = 0
' End If
'Devuelve el numero de filas cargadas
LoadGrid = iCont - 1
'Reestablecer el mouse y repintar el grid
Grid.Redraw = True
Grid.MousePointer = flexDefault
If Grid.RowHeight(iFixed) = 0 And bVisuMens Then
cMensaje = "No se han encontrado registros," & _
Chr(13) & "que cumplen las condiciones de búsqueda."
MsgBox cMensaje, vbOKOnly + vbExclamation, "Seleccion"
End If
rRes.Close
End If
Exit Function
GestError:
Grid.MousePointer = flexDefault
Select Case Err
Case 3261
cMensaje = "La tabla está bloqueada en modo exclusivo."
Case Else
cMensaje = "Se ha producido el error:" & Err.Description
End Select
MsgBox cMensaje, vbOKOnly + vbCritical, "Error:" + str$(Err)
End Function
