Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Progress Bar During Recordset Query

Status
Not open for further replies.
heprox

heprox

IS-IT--Management
Dec 16, 2002
178
US
I have a simple application that queries an Oracle datasource using ODBC and ADODB. The table that I'm hitting is immense and can at times take 10-15 minutes to respond to simple queries. I would like to have a simple graphical progress bar in my code to show the status of the query as it proceeds, however I thought that with ADODB using ODBC for a connection, it is impossible to have the database communicate back to the application the progress of the query until the recordset is returned? If thats the case then is it possible to just have a sort of "while you wait" progess bar (sort of like the progress bar you see when Windows XP boots up) that doesn't really correlate to the query of the recordset, just really lets the user know that the application is still searching for the records? Hers is my code for the connection:

Code: 
Option Explicit
Public rsmain As ADODB.Recordset
Public cn As ADODB.Connection
'connection variables
Public gstrDSN As String
Public gstrUser As String
Public gstrPassword As String
Public Function OpenDatabaseConnection() As Boolean
On Error GoTo errhandler
Dim connectionstring As String
    Set cn = New ADODB.Connection
    cn.Provider = "MSDAORA.1"
    cn.connectionstring = "Password=" & gstrPassword & ";Persist Security Info=True;User ID=" & gstrUser & ";Data Source=" & gstrDSN
    cn.CursorLocation = adUseClient
    cn.Open
    OpenDatabaseConnection = True
    Exit Function
errhandler:
    MsgBox "Connection failed, Enter Login Parameters Again", vbCritical
    OpenDatabaseConnection = False
    Exit Function
End Function

...and here is my code for the actual query:

Code: 
Private Sub cmdEnter_Click()
On Error GoTo errhandler
Dim strsql As String
Dim inti As Integer
Dim blnflag As Boolean
Dim wasNull As Boolean
    If txtSKU.Text = "" Then
        MsgBox "SKU cannot be empty, please enter a valid SKU...", vbCritical
        txtSKU.SetFocus
        Exit Sub
    End If
    strsql = " select trn_dt, ins_dt_time, sku_num, store_cd, other_store_cd, trn_tp, qty, ext_cst, ship_num, keyrec_num, processed_flag" & _
             " from pipe_inv_trn where sku_num = '" & txtSKU.Text & "'" & _
             " and store_cd = '" & cboFromStoreNo.Text & "'" & _
             " and other_store_cd = '" & cboToStoreNo.Text & "'"
    Set rsmain = New ADODB.Recordset
    rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
    If rsmain.EOF Then
        MsgBox "SKU data data does not exist for this location combination...", vbCritical
        txtSKU.Text = ""
        txtSKU.SetFocus
        Exit Sub
    Else
            blnflag = False
            For inti = 1 To MSFItem.Rows - 1
                If Left(MSFItem.TextMatrix(inti, 0), 9) = txtSKU.Text Then
                    blnflag = True
                    Exit For
                End If
            Next
            If blnflag = False Then
                Do While Not rsmain.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain("trn_dt")
                    MSFItem.TextMatrix(inti, 1) = rsmain("ins_dt_time")
                    MSFItem.TextMatrix(inti, 2) = rsmain("sku_num")
                    MSFItem.TextMatrix(inti, 3) = rsmain("store_cd")
                    MSFItem.TextMatrix(inti, 4) = rsmain("other_store_cd")
                    MSFItem.TextMatrix(inti, 5) = rsmain("trn_tp")
                    MSFItem.TextMatrix(inti, 6) = rsmain("qty")
                    MSFItem.TextMatrix(inti, 7) = rsmain("ext_cst")
                    MSFItem.TextMatrix(inti, 8) = rsmain("ship_num")
                    MSFItem.TextMatrix(inti, 9) = rsmain("keyrec_num")
                    MSFItem.TextMatrix(inti, 10) = rsmain("processed_flag")
                    rsmain.MoveNext
                Loop
            Else
                MsgBox " This Item is already entered", vbInformation
            End If
            txtSKU.Text = ""
            txtSKU.SetFocus
            Exit Sub
        End If
    Exit Sub
errhandler:
    MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical
    Exit Sub
End Sub

...how should I go about adding some type of graphical reference to let the user know that the application is still running?
 
Sort by date Sort by votes
Instead of a progress bar (which similar to microsoft's own will not show any relevance to how far the app/query has progressed) you could have an animation (hourglass etc) or change the mouse pointer?

Harleyquinn

---------------------------------
For tsunami relief donations
 
Upvote 0 Downvote
you could change your mouse pointer to an hourglass just before you start the query and then change it back once it's done.

_______
I love small animals, especially with a good brown gravy....
 
Upvote 0 Downvote
Or you could find an mpeg video of a high voltage power line arching to ground and play it in a loop... just for fun...

 
Upvote 0 Downvote
How about an MP3 file of Enya? Nice soothing music while you wait.

_______
I love small animals, especially with a good brown gravy....
 
Upvote 0 Downvote
OK now I'm completely confused.... Lets say that all I want to do is have a new form (frmProgress) that pops up when the user chooses "Enter" and has an animation (AVI) file play while the query is taking place. Then when the application returns a recordset "frmProgress" will dissappear. On "frmProgress" I'll have a message that says something like, "Searching database, please wait...." and then have the animation in the loop. Does anybody have a good example of this, I'm stumped? To make the new form appear I'd do something like:

Code: 
Private Sub cmdEnter_Click()
frmProgress.Show
On Error GoTo errhandler
Dim strsql As String
Dim inti As Integer
Dim blnflag As Boolean
'Dim wasNull As Boolean
    If txtSKU.Text = "" Then
        MsgBox "SKU cannot be empty, please enter a valid SKU...", vbCritical
        txtSKU.SetFocus
        Exit Sub
    End If
    strsql = " select trn_dt, ins_dt_time, sku_num, store_cd, other_store_cd, trn_tp, qty, ext_cst, ship_num, keyrec_num, processed_flag" & _
             " from pipe_inv_trn where sku_num = '" & txtSKU.Text & "'" & _
             " and store_cd = '" & cboFromStoreNo.Text & "'" & _
             " and other_store_cd = '" & cboToStoreNo.Text & "'"
    Set rsmain = New ADODB.Recordset
    rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
    frmProgress.Hide
    If rsmain.EOF Then
        MsgBox "SKU data data does not exist for this location combination...", vbCritical
        txtSKU.Text = ""
        txtSKU.SetFocus
        Exit Sub
    Else
            blnflag = False
            For inti = 1 To MSFItem.Rows - 1
                If Left(MSFItem.TextMatrix(inti, 0), 9) = txtSKU.Text Then
                    blnflag = True
                    Exit For
                End If
            Next
            If blnflag = False Then
                Do While Not rsmain.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = rsmain("trn_dt")
                    MSFItem.TextMatrix(inti, 1) = rsmain("ins_dt_time")
                    MSFItem.TextMatrix(inti, 2) = rsmain("sku_num")
                    MSFItem.TextMatrix(inti, 3) = rsmain("store_cd")
                    MSFItem.TextMatrix(inti, 4) = rsmain("other_store_cd")
                    MSFItem.TextMatrix(inti, 5) = rsmain("trn_tp")
                    MSFItem.TextMatrix(inti, 6) = rsmain("qty")
                    MSFItem.TextMatrix(inti, 7) = rsmain("ext_cst")
                    MSFItem.TextMatrix(inti, 8) = rsmain("ship_num")
                    MSFItem.TextMatrix(inti, 9) = rsmain("keyrec_num")
                    MSFItem.TextMatrix(inti, 10) = rsmain("processed_flag")
                    rsmain.MoveNext
                Loop
            Else
                MsgBox " This Item is already entered", vbInformation
            End If
            txtSKU.Text = ""
            txtSKU.SetFocus
            Exit Sub
        End If
    Exit Sub
errhandler:
    MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical
    Exit Sub
End Sub
 
Upvote 0 Downvote
Or you could just make it easy on yourself and put the animation on the same form but not playing and invisible.

Then turn it on and make it visible immediately before you execute the query.

Dunno what your form looks like.. this way might be cool or ugly depending.
 
Upvote 0 Downvote
Good idea, I think I might use that on another project but it wouldn't look right on this one. What I need to work out is how to get the animation to play in a loop when the new form loads?
 
Upvote 0 Downvote
You have to remember that a VB application is actually single-threaded, which means that normally it can only actually do one thing at a time (and is the reason we need such functions as DoEvents to fake doing more than one thing at a time, such as updating a progress bar whilst iterating a tight loop). So ... when you run a query VB sits on its thread waiting for the query to finish before it will proceed with the next statement. It won't run anything else ... such as a frmProgress

Unless, of course, you could find a way of running the query asynchronously ...

(i.e do a search for asynchronous ODBC SQL calls)
 
Upvote 0 Downvote
Here is the Form_Load event for a form that I made that plays the electrical arc movie.

Private Sub Form_Load()
WindowsMediaPlayer1.URL = "c:\arc.mpa"
WindowsMediaPlayer1.uiMode = "none"
WindowsMediaPlayer1.Width = Form1.Width
WindowsMediaPlayer1.Height = Form1.Height
WindowsMediaPlayer1.Top = 0
WindowsMediaPlayer1.Left = 0
WindowsMediaPlayer1.settings.setMode "loop", True
End Sub


You need the Windows Media Player component so from the menu Projects -> Components -> Windows Media Player

Also change the URL property to your movie.
 
Upvote 0 Downvote
OK I got it working with the Animation control playing an AVI file when the form loads, however the form just goes blank when the query starts and doen't come back until the query is over? I thought Windows Animation Control handled things in their own thread?
 
Upvote 0 Downvote
Well I had to back track, Animation Control for some reason was not working correctly at all so I started messing with Events:

Code: 
Private WithEvents rsmain As Recordset

Private Sub rsmain_FetchProgress(ByVal Progress As Long, ByVal MaxProgress As Long, _
 adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    With frmProgress.ProgressBar1
        .Max = MaxProgress
        .value = Progress
        .Refresh
    End With
End Sub

...and this code for my query:

Code: 
Private Sub cmdEnter_Click()
On Error GoTo errhandler
Dim strsql As String
Dim inti As Integer
Dim blnflag As Boolean
Dim wasNull As Boolean
    If txtSKU.Text = "" Then
        MsgBox "SKU cannot be empty, please enter a valid SKU...", vbCritical
        txtSKU.SetFocus
        Exit Sub
    End If
    strsql = " select trn_dt, ins_dt_time, sku_num, store_cd, other_store_cd, trn_tp, qty, ext_cst, ship_num, keyrec_num, processed_flag" & _
             " from pipe_inv_trn where sku_num = '" & txtSKU.Text & "'" & _
             " and store_cd = '" & cboFromStoreNo.Text & "'" & _
             " and other_store_cd = '" & cboToStoreNo.Text & "'"
    Set rsmain = New ADODB.Recordset
    rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
    If rsmain.EOF Then
        MsgBox "SKU data data does not exist for this location combination...", vbCritical
        txtSKU.Text = ""
        txtSKU.SetFocus
        Exit Sub
    Else
            blnflag = False
            For inti = 1 To MSFItem.Rows - 1
                If Left(MSFItem.TextMatrix(inti, 0), 11) = txtSKU.Text Then
                    blnflag = True
                    Exit For
                End If
            Next
            If blnflag = False Then
                Do While Not rsmain.EOF()
                    If MSFItem.TextMatrix(1, 0) = "" Then
                        inti = 1
                    Else
                        inti = MSFItem.Rows
                        MSFItem.Rows = MSFItem.Rows + 1
                    End If
                    wasNull = False
                    MSFItem.TextMatrix(inti, 0) = IfNull(rsmain("trn_dt"), wasNull, "")
                    MSFItem.TextMatrix(inti, 1) = IfNull(rsmain("ins_dt_time"), wasNull, "")
                    MSFItem.TextMatrix(inti, 2) = rsmain("sku_num")
                    MSFItem.TextMatrix(inti, 3) = rsmain("store_cd")
                    MSFItem.TextMatrix(inti, 4) = rsmain("other_store_cd")
                    MSFItem.TextMatrix(inti, 5) = IfNull(rsmain("trn_tp"), wasNull, "")
                    MSFItem.TextMatrix(inti, 6) = IfNull(rsmain("qty"), wasNull, "")
                    MSFItem.TextMatrix(inti, 7) = IfNull(rsmain("ext_cst"), wasNull, "")
                    MSFItem.TextMatrix(inti, 8) = IfNull(rsmain("ship_num"), wasNull, "")
                    MSFItem.TextMatrix(inti, 9) = IfNull(rsmain("keyrec_num"), wasNull, "")
                    MSFItem.TextMatrix(inti, 10) = IfNull(rsmain("processed_flag"), wasNull, "")
                    rsmain.MoveNext
                Loop
            Else
                MsgBox " This SKU is already entered", vbInformation
            End If
            txtSKU.Text = ""
            txtSKU.SetFocus
            Exit Sub
        End If
    Exit Sub
errhandler:
    MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical
    Exit Sub
End Sub

...I dropped a Progress Bar control on the form, however nothing is happening so I'm confused. I think I'm missing a "doEvents" statement somewhere for the ADO to update the progress bar?
 
Upvote 0 Downvote
FetchProgress only works if you are doing, as I suggested, an asynchronous fetch of the data. Might I suggest you investigate the following Option flag: adAsyncFetch
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

sal21
  • Locked
  • Question
FILL RICHTEXTBOX WITH RECORDSET
Replies
4
Views
513
strongm
strongm
sal21
  • Locked
  • Question
UPDATE DAO RECORDSET 1
Replies
11
Views
716
strongm
strongm
2009luca
  • Locked
difficult to crteate a query very complicated 1
Replies
9
Views
1K
Andrzejek
Andrzejek
sal21
  • Locked
  • Question
dont show the acrobat window during the printing
Replies
3
Views
371
combo
combo
sal21
  • Locked
  • Question
fill array from recordset
Replies
6
Views
787
2009luca
2009luca

Part and Inventory Search

Sponsor

Back
Top