ADO+Progress Bar

El recordset de ADO tiene un evento fetchProgress, aquí puedes ir revisando como va el progreso de la consulta
Saludos
Roberto Alvarado
Cartagena - Colombia

Gracias, pero mi driver de OLEDB para Interbase no acepta consultas asincronicas !
¿Alguna otra alternativa?

Antes de nada... pedirte perdón por la tardanza en la respuesta.
Le he estado dando vueltas y se me ha ocurrido una manera que no se si servirá. Te cuento dependiendo del servidor de BD que estés atacando tienes que probar si puedes poner la sentencia select con top para ir descargando por ejemplo de 100 en 100 los registros y cada vez que descargues 100 registros vas incrementando la progress bar.
Espero que te sirva. Por más vueltas que le he dado no se me ha ocurrido otra solución porque no puedes saber a priori ni cuanto vas a tardar en recuperar los registros ni cuantos son por lo que no tendría una correlación la progressbar con lo que vas obteniendo de la base de datos.
Ya me contarás...

Mi método es sencillo :
Tengo una clase ClsBarraProgreso.
Con este código :
Private Sub Class_Initialize()
frmBarra.ProgressBar1.Value = 0
End Sub
''*********************************************************************
''* Nombre:inicializar
''* Descripción:Muestra la barra
''* Parámetros de Entrada:1 : Modal 0 : no modal
''* Parámetros de salida:<ninguno>
''*********************************************************************
Public Sub intInicializar(ByVal PeintModal As Integer, PestrRotulo As String)
If PeintModal <> 1 And PeintModal <> 0 Then
MsgBox "Barra de proceso mal inicializada"
Exit Sub
End If
frmBarra.Visible = True
frmBarra.Caption = PestrRotulo
frmBarra.Show PeintModal
DoEvents ' Asi se dibuja completamente la ventana antes de continuar
End Sub
'*********************************************************************
'* Nombre:intAsignarValor
'* Descripción:situa la barra en un tanto por ciento
'* Parámetros de Entrada:<ninguno>
'* Parámetros de salida:<ninguno>
'*********************************************************************
Public Sub intAsignarValor(ByVal Peint As Integer)
If Peint < 0 Or Peint > 100 Then
MsgBox "Valos incorrecto asignado al objeto barra de progreso "
Exit Sub
End If
frmBarra.ProgressBar1.Value = Peint
If Peint Mod 10 Then DoEvents
End Sub
Public Sub intQuitar()
Unload frmBarra
End Sub
Public Sub PonerEtiqueta(cadena As String)
frmBarra.Label1.Caption = cadena
End Sub
y este formulario que precisa la barra :
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmBarra
Caption = "Progreso en Curso"
ClientHeight = 825
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
Icon = "frmBarra.frx":0000
LinkTopic = "Form1"
ScaleHeight = 825
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin MSComctlLib.ProgressBar ProgressBar1
Height = 255
Left = 0
TabIndex = 0
Top = 480
Width = 4575
_ExtentX = 8070
_ExtentY = 450
_Version = 393216
Appearance = 1
End
Begin VB.Label Label1
Caption = "Etiqueta"
Height = 255
Left = 600
TabIndex = 1
Top = 120
Width = 3495
End
End
Attribute VB_Name = "frmBarra"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Deactivate()
Me.ZOrder
End Sub
Para llamar a la barra genero el código asi :
Set objBarra = New ClsBarraProgreso
objBarra.intInicializar 0, "Progreso realizado"
while (i <último elemento)
.
.
.
ObjBarra. IntAsignarValor ((i - 1) / maxvalor * 100)
objBarra.PonerEtiqueta "Registro " & i & " de " & maxvalor
.
.
.
Wend
ObjBarra. IntQuitar
Set objBarra = Nothing
Así, me he generado mi clase BarraProgreso. Elimino de ese modo el tener que generarme una cada vez. No pierdo velocidad en desarrollo y me parece sencilla de entender.

Antes que nada muchas gracias por contestar.
Me parece muy buena tu idea de la clase para la barra pero mi problema, que no lo explique muy bien, es que cuando mi programa pasa por la linea: rs.open "select * from mitabla" ...
Demora mucho tiempo en traer los 50 mil registros que necesito y el usuario lo único que ve mientras espera es el vbHourGlass y lo que yo quiero es mostrarle una barra de progreso a medida que el recordset se va llenando.
Muchas Gracias de todos modos.
josé

Esta pregunta es más bien entonces de Administración de BBDD. La forma de obtener el número de elementos más rápida es a través de un
select count(1) from tuTabla;
.
Así obtienes el número máximo de elementos. Para que la consulta sea óptima, reduce el tiempo de la consulta añadiendo indice a la primaria, si tu BBDD no lo hace por defecto. Así obtendrás el número de elementos en instantes.

Si, si, gracias por los consejos, pero yo puntualmente lo que necesito es poder mostrarle al usuario una barra de progreso mientras el cliente abre un recordset de 50 mil registros aprox. que lo necesito si o si y no se puede optimizar más de lo que ya esta la velocidad, ademas es a través de una WAN, ya se lo de los indices, select count, etc... pero esto es una necesidad puntual y no queda otra que esperar mientras el sistema abre el recordset.

Te pongo en este caso, como hago yo mi consulta, por red, a una tabla de Oracle de más de 200.000 registros. Para lo cual he generado la barra...
Si no te sirve, entonces, cierra la pregunta, o explícamela un poco, porque no la entiendo.
------- CÓDIGO FUENTE -------
Dim aux As Long
Dim i As Long
Dim Sql As String
Dim rs As Recordset
Dim maxvalor As Long
Me.Caption = "Generando Valores"
Sql = " Select count(1) from VWSHEETMONITORDATA"
Set rs = ObjConexion.ExecuteQuery(Sql)
Set objBarra = New ClsBarraProgreso
maxvalor = rs(0)
Me.Caption = "Generador de Evaluaciones"
objBarra.intInicializar 0, "Progreso realizado"
Sql = " Select ID_SHEET, PRIMARIO, SECUNDARIO, POSICIONPRIMARIO, POSICIONSECUNDARIO, WINDOW, REPRESENTACIONPRIMARIO, REPRESENTACIONSECUNDARIO, ID_SHEETVALUE, DBL_ACCUERACY from VWSHEETMONITORDATA "
Set rs = ObjConexion.ExecuteQuery(Sql)
'2.- Abro el Archivo Destino
objExcel.AbrirExcel (File1.Path & "\" & File1.FileName)
objExcel.AbrirHoja ("Fichas")
i = 1
For aux = 0 To rs.Fields.Count - 1
objExcel.PonerValorCelda i, aux + 1, rs.Fields(aux).Name
Next
i = 2
While Not rs.EOF
'3.- Almaceno los datos del archivo destino
For aux = 0 To rs.Fields.Count - 1
objExcel.PonerValorCelda i, aux + 1, rs.Fields(aux).Value
Next
objBarra.intAsignarValor (((i - 1) / maxvalor) * 100)
objBarra.PonerEtiqueta "Registro " & i & " de " & maxvalor
i = i + 1
rs.MoveNext
Wend
ObjBarra. IntQuitar
ObjExcel. CerrarExcel
Set objBarra = Nothing

No uses esto para excel... que me lo cargue al sobrecargarlo con registros...
Vamos, que es solo un ejemplo

Mi código es muy parecido al tuyo pero la linea en que mi programa se demora mucho es en:
--------------------------------------
Set rs = ObjConexion.ExecuteQuery(Sql)
--------------------------------------
Y luego una vez abierto ya puedo poner una barra de progreso si quiero, ¿pero cómo hago para poner una barra de proceso mientras espero que se ejecute la query?
Muchas gracias por tu paciencia.

Creo que es esto lo que buscas...
'----------------------------------------------------
'##ModelId=391EAD99031A
Public Function EjecutarSelect(ByVal PestrSQL As String, Optional ByVal blnAsincrono As Boolean = False) As ConjuntoRegistros
' Para usar con OLEDB
Dim innerRS As ADODB.Recordset
' Para usar con RDO
Dim RSrdo As rdoResultset
' Comun para todos
Dim innerCR As ConjuntoRegistros
On Error GoTo errorCHK
If (Right(PestrSQL, 1) <> strFinalSQL()) Then
'PestrSQL = PestrSQL & strFinalSQL()
End If
If Not blnAsincrono Then
If ModoCon = ConOleDB Then
Set innerRS = madcConex.Execute(PestrSQL)
ElseIf ModoCon = ConRdo Then
Set RSrdo = rdocn.OpenResultset(PestrSQL, rdOpenForwardOnly, rdConcurReadOnly, rdExecDirect)
End If
Else
If ModoCon = ConOleDB Then
Set innerRS = New ADODB.Recordset
innerRS.CacheSize = 30
InnerRS. Open PestrSQL, madcConex. ConnectionString, adOpenForwardOnly, adLockBatchOptimistic, adAsyncFetch
ElseIf ModoCon = ConRdo Then
Set RSrdo = rdocn.OpenResultset(PestrSQL, rdOpenForwardOnly, rdConcurReadOnly, rdAsyncEnable)
End If
End If
If ModoCon = ConOleDB Then
If innerRS.EOF And innerRS.BOF Then
'''Ana Mª Martin 30/11/2000
'''mintEstado = intEBDVacia()
mintEstado = intERSVacio()
Else
Set innerCR = New ConjuntoRegistros
Call innerCR.intSetReg(innerRS)
' If (innerCR.intFEstado() = innerCR.intERSVacio()) Then
' mintEstado = (Me.intEBDVacia())
' Exit Function
' End If
' If (innerCR.intFEstado() = innerCR.intEOracleRecordset()) Then
' mintEstado = (Me.intESQL)
' mstrErrSQL = innerCR.strDescEstado
' Exit Function
' End If
If (innerCR.intFEstado() <> innerCR.intEBien()) Then
mintEstado = (intEMal())
Exit Function
End If
Set EjecutarSelect = innerCR
If innerCR.blnFinal And innerCR.blnInicio Then
'''Ana Mª Martin 30/11/2000
'''mintEstado = intEBDVacia()
mintEstado = intERSVacio()
Else
mintEstado = intEBien()
End If
End If
ElseIf ModoCon = ConRdo Then
If RSrdo.EOF And RSrdo.BOF Then
mintEstado = intERSVacio()
Else
Set innerCR = New ConjuntoRegistros
Call innerCR.intSetRegRDO(RSrdo)
If (innerCR.intFEstado() <> innerCR.intEBien()) Then
mintEstado = (intEMal())
Exit Function
End If
Set EjecutarSelect = innerCR
If innerCR.blnFinal And innerCR.blnInicio Then
mintEstado = intERSVacio()
Else
mintEstado = intEBien()
End If
End If
End If
Exit Function

(Avisame cuando te canse así no te molesto más... muchas gracias de todas formas por las respuestas.)
Ya probé abrir asyncronicamente pero en la linea:
--------------------------
rsMov.Open ST, db.Conn, adOpenForwardOnly, adLockBatchOptimistic, adAsyncFetch
--------------------------
Sigue siendo el cuello de botella.
Me parece que recién en tu código te falto pasarme la clase "ConjuntoRegistros" .
Gracias.

Si actualizas a rownum una columna, esta inserta valores consecutivos a la tabla que pueden ser considerados como IDs. De este modo
Update Tabla set Campo = RowNum
Si a partir de el max (Campo) sabes el num de elementos en la consulta, puedes dividir la consulta en subconsultas de NumMax/ 10 y cada vez que termine una sub consulta, rellenar el 10% de la ProgressBar...
Y no se me ocurre mucho más.
Suerte