Adding a progress bar while the flexgrid is populating
I'm finishing up a project that uses a flexgrid to display recordsets. I have a flexgrid that, depending on what button the user chooses the grid populates accordingly. Certain queries take a couple of seconds longer that others, but the grid is adding rows the whole time. I want the progress bar to increase as the rows in the flexgrid increase to allow the user to see the progress of the query.
Code:
Private Sub XPButton1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
Dim strsql As String
Dim inti As Integer
Dim wasNull As Boolean
Dim i As Integer
Dim j As Integer
On Error GoTo errhandler
With MSFItem
.Clear
.Rows = 2
Select Case Index
Case 0
.Clear
.Rows = 2
.Cols = 6
.FormatString = "^SKU |^QTY |^Size |^Color |^First Receive Date |^UPC "
strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, b.first_rcv_dt, " & _
" d.upc_cd from gm_inv_loc a, gm_sku b, gm_itm c, gm_sku2upc_cd d" & _
" Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And b.sku_num = d.sku_num" & _
" and c.itm_cd = '" & lblItemCode.Caption & "' group by a.sku_num, b.size_cd, b.color_des, b.first_rcv_dt, d.upc_cd" & _
" order by a.sku_num"
Case 1
.Clear
.Rows = 2
.Cols = 6
.FormatString = "^Item code |^QTY |^Store Code |^District Code |^Store Name |^Square Footage "
strsql = "select a.itm_cd, sum(c.avail_qty) qty, c.store_cd, d.op_dist_cd, d.store_name, " & _
" d.sq_ft from gm_itm a, gm_sku b, gm_inv_loc c, store d" & _
" Where a.itm_cd = b.itm_cd And b.sku_num = c.sku_num and c.store_cd = d.store_cd" & _
" and a.itm_cd = '" & lblItemCode.Caption & "'" & _
" group by a.itm_cd, c.store_cd, d.op_dist_cd, d.store_name, d.sq_ft"
Case 2
.Clear
.Rows = 2
.Cols = 8
.FormatString = "^SKU |^QTY |^Size |^Color |^Store Code |^Store Name |^District Code |^Square Footage "
strsql = "select a.sku_num, sum(a.avail_qty) qty, b.size_cd, b.color_des, a.store_cd, d.store_name, d.op_dist_cd, d.sq_ft" & _
" from gm_inv_loc a, gm_sku b, gm_itm c, store d" & _
" Where a.sku_num = b.sku_num And b.itm_cd = c.itm_cd And a.store_cd = d.store_cd" & _
" and c.itm_cd = '" & lblItemCode.Caption & "' group by a.sku_num, b.size_cd, b.color_des, a.store_cd," & _
" d.store_name , d.op_dist_cd, d.sq_ft order by a.store_cd, a.sku_num"
Case 3
.Clear
.Rows = 2
.Cols = 11
.FormatString = "^PO# |^Vendor Code |^Factory Code |^Status |^On Order QTY |^Ship Via |^FOB |^Order Date |^Start Ship Date |^ETA Date |^PO Type "
strsql = "select distinct(a.po_num), a.ve_cd, a.fact_cd, a.stat_cd, sum(b.qty) qty," & _
" a.ship_via, a.fob, a.ord_dt, a.do_not_ship_before_dt, a.ship_cmplt_dt, a.dist_method_cd" & _
" from gm_po a, gm_po_ln b Where a.po_num = b.po_num and b.itm_cd = '" & lblItemCode.Caption & "'" & _
" and a.stat_cd != 'CANC'" & _
" group by a.po_num, a.ve_cd, a.fact_cd, a.stat_cd, a.emp_init_buy," & _
" a.ship_via, a.fob, a.ord_dt, a.do_not_ship_before_dt, a.ship_cmplt_dt, a.dist_method_cd"
End Select
Set rsmain = New ADODB.Recordset
rsmain.Open strsql, cn, adOpenKeyset, adLockReadOnly
If rsmain.EOF Then
Select Case Index
Case "bmnSize"
MsgBox "This item does not have any current inventory information.", vbCritical, "No Total Inventory Records Found"
Case "bmnStore"
MsgBox "This item does not have any current location inventory records.", vbInformation, "No Location Inventory Records Found"
Case "bmnSKU"
MsgBox "This item does not have any current SKU/location inventory records.", vbInformation, "No SKU/Location Records Found."
Case "bmnPO_Main"
MsgBox "This item does not have any current PO records.", vbInformation, "No Current PO Records Found"
End Select
Else
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
Select Case Index
Case 0
.TextMatrix(inti, 0) = rsmain("sku_num")
.TextMatrix(inti, 1) = rsmain("qty")
.TextMatrix(inti, 2) = IfNull(rsmain("size_cd"), wasNull, "")
.TextMatrix(inti, 3) = IfNull(rsmain("color_des"), wasNull, "")
.TextMatrix(inti, 4) = IfNull(rsmain("first_rcv_dt"), wasNull, "")
.TextMatrix(inti, 5) = IfNull(rsmain("upc_cd"), wasNull, "")
Case 1
.TextMatrix(inti, 0) = rsmain("itm_cd")
.TextMatrix(inti, 1) = IfNull(rsmain("qty"), wasNull, "")
.TextMatrix(inti, 2) = IfNull(rsmain("store_cd"), wasNull, "")
.TextMatrix(inti, 3) = IfNull(rsmain("op_dist_cd"), wasNull, "")
.TextMatrix(inti, 4) = IfNull(rsmain("store_name"), wasNull, "")
.TextMatrix(inti, 5) = IfNull(rsmain("sq_ft"), wasNull, "")
Case 2
.TextMatrix(inti, 0) = rsmain("sku_num")
.TextMatrix(inti, 1) = rsmain("qty")
.TextMatrix(inti, 2) = IfNull(rsmain("size_cd"), wasNull, "")
.TextMatrix(inti, 3) = IfNull(rsmain("color_des"), wasNull, "")
.TextMatrix(inti, 4) = IfNull(rsmain("store_cd"), wasNull, "")
.TextMatrix(inti, 5) = IfNull(rsmain("store_name"), wasNull, "")
.TextMatrix(inti, 6) = IfNull(rsmain("op_dist_cd"), wasNull, "")
.TextMatrix(inti, 7) = IfNull(rsmain("sq_ft"), wasNull, "")
Case 3
.TextMatrix(inti, 0) = rsmain("po_num")
.TextMatrix(inti, 1) = rsmain("ve_cd")
.TextMatrix(inti, 2) = IfNull(rsmain("fact_cd"), wasNull, "")
.TextMatrix(inti, 3) = IfNull(rsmain("stat_cd"), wasNull, "")
.TextMatrix(inti, 4) = IfNull(rsmain("qty"), wasNull, "")
.TextMatrix(inti, 5) = IfNull(rsmain("ship_via"), wasNull, "")
.TextMatrix(inti, 6) = IfNull(rsmain("fob"), wasNull, "")
.TextMatrix(inti, 7) = IfNull(rsmain("ord_dt"), wasNull, "")
.TextMatrix(inti, 8) = IfNull(rsmain("do_not_ship_before_dt"), wasNull, "")
.TextMatrix(inti, 9) = IfNull(rsmain("ship_cmplt_dt"), wasNull, "")
.TextMatrix(inti, 10) = IfNull(rsmain("dist_method_cd"), wasNull, "")
End Select
For i = 1 To .Rows - 1 Step 2
.Row = i
For j = 0 To .Cols - 1
.Col = j
.CellBackColor = &HC0FFFF
Next j
rsmain.MoveNext
Loop
End If
End With
errhandler:
If Err Then
MsgBox "Errors occured while retreiving the item information" & vbCrLf & "Please Click on Reset Button and Redo the process" & vbCrLf & Err.Number & ":" & Err.Description, vbCritical, "Error"
End If
End Sub
...could someone show me the best way to do this. Last time I tried to use the progress bar control I failed miserably (through no ones fault but my own), but I really want to get this control to work correctly in this application.
Re: Adding a progress bar while the flexgrid is populating
VB Code:
ProgressBar1.Min = 0
ProgressBar1.Max = 100
'Your Code
'
'
Do While Not rsmain.EOF()
'Your Code
'
'
ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
Loop
Re: Adding a progress bar while the flexgrid is populating
Re: Adding a progress bar while the flexgrid is populating
This code:
Code:
ProgressBar1.Min = 0
ProgressBar1.Max = 100
'Your Code
'
'
Do While Not rsmain.EOF()
'Your Code
'
'
ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
Loop
...worked perfectly for what I wanted but I keep getting errors (Invalid property value) when the recordset is complete? When the last record is populated into the grid the error handler fires? The debugger comes back on the:
Code:
ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
Re: Adding a progress bar while the flexgrid is populating
Slightly incorrect:
VB Code:
ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
should be
VB Code:
ProgressBar1.Value = int(rsmain.AbsolutePosition / rsmain.RecordCount) * 100
Re: Adding a progress bar while the flexgrid is populating
I'm still getting the error even with:
Code:
ProgressBar1.Value = int(rsmain.AbsolutePosition / rsmain.RecordCount) * 100
I looked at the values that are being returned with:
Code:
Debug.Print Int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
and noticed that the values are coming back as negatives, depending on the values entered by the user. It appears that the values are out of the range set for the progressbar?
Re: Adding a progress bar while the flexgrid is populating
Print out the value for AbsolutePosition. I'm not sure if that is correct.
Didn't you see the link that i posted earlier? It has pretty good code that lets the actual query control the progressbar, so that you don't have to do anything once it is set up.
Re: Adding a progress bar while the flexgrid is populating
I saw the code and would love to use it, but to be honest I'm confused in how to implement it correctly. I messed around with it forever and couldn't get it to work correctly. My skills with VB are primarily applications that deal with recordsets and database connections, this is the first time I've ever tried to use a Progress Bar.
The value for AbsolutePosition is "-3"
Re: Adding a progress bar while the flexgrid is populating
Are u using a server side cursor?? The code above will work only for client side cursors. For serverside cursors, the values of recordcount and absoluteposition are returned wrong.
Secondly, ain't these two statements the same (dglienna)?
ProgressBar1.Value = int(rsmain.AbsolutePosition * 100 / rsmain.RecordCount)
ProgressBar1.Value = int(rsmain.AbsolutePosition / rsmain.RecordCount) * 100
Re: Adding a progress bar while the flexgrid is populating
How would I tell whether or not I'm using a server side cursor?
Re: Adding a progress bar while the flexgrid is populating
They were reversed.
Quote:
ProgressBar1.Value = int(rsmain.RecordCount * 100 / rsmain.AbsolutePosition )
Re: Adding a progress bar while the flexgrid is populating
In the debug window check "?rs.CursorLocation= adUseClient" is true or "?rs.CursorLocation= adUseServer" is true. Many a times if you set the cursor location from code but is not supported by the provider, they are reset by the provider.
In case it is a server side cursor, don't use absoluteposition property. Instead keep a counter in the loop and use that.
Sample Code:
VB Code:
Dim nCurrRec as long
ProgressBar1.Min = 0
ProgressBar1.Max = 100
'Your Code
'
'
nCurrRec = 0
Do While Not rsmain.EOF()
'Your Code
'
'
nCurrRec =nCurrRec +1
ProgressBar1.Value = int(nCurrRec * 100 / rsmain.RecordCount)
Loop
Edit: This code would work, whichever cursor you are working :)
