Tiempo de Espera agotado para la consulta

[lego3167]

Estimados estoy ejecutando un procedimiento almacenado desde el visual basic 6.0 pero me aparece este mensaje "Tiempo de Espera agotado para la consulta". Realice la prueba en sql server dicha ejecución no se demora ni 10 segundos. Estimados favor su ayuda.

Private Sub PL_Buscar()

Call AbrirBase
Set Cmd = New ADODB.Command
Set RS = New ADODB.Recordset
With Cmd
.ActiveConnection = CN
.CommandType = adCmdStoredProc
'.CommandTimeout = 100
.CommandText = "SIA_PRODUC..sp_comparativos"
.Parameters.Append .CreateParameter("@i_operacion ", adVarChar, adParamInput, 8, "UP")
.Parameters.Append .CreateParameter("@i_fecha_ini ", adVarChar, adParamInput, 20, Null)
.Parameters.Append .CreateParameter("@i_fecha_fin ", adVarChar, adParamInput, 20, Null)
.Parameters.Append .CreateParameter("@i_filial ", adInteger, adParamInput, , VGFilial)
.Parameters.Append .CreateParameter("@i_oficina ", adInteger, adParamInput, , VGOficina)
.Parameters.Append .CreateParameter("@i_categoria ", adInteger, adParamInput, , 9)
End With
With RS
.CursorLocation = adUseClient
.Open Cmd, , adOpenStatic, adLockReadOnly, adCmdStoredProc
Call Barra_Proceso(F_ON, "Consultando el Promedio de Insumos...")
grdregistros.MaxRows = 0
If .State <> 0 Then
Do Until .EOF
grdregistros.MaxRows = grdregistros.MaxRows + 1
grdregistros.Row = grdregistros.MaxRows
For i = 1 To grdregistros.MaxCols
grdregistros.Col = i
grdregistros.text = .Fields(i - 1)
grdregistros.Lock = True
Next i
.MoveNext
Loop
End If
End With
If RS.State <> 0 Then
CerrarCursor
End If
CerrarBase
Call Barra_Proceso(F_OFF, "")
If grdregistros.MaxRows > 0 Then
fra_hidden.Visible = False
grdregistros.Visible = True
PL_Obt_titulo
End If

El mensaje me aparece en el open.
Esperando alguna solución les agradezco de antemano.