Progress Bar

Hi: How to i fixed the progress bar so that it will shows the estimated time and value in percentage that how much is done. Right now the way i used is, just start from 1 and when it goes to 100 then it again 0.

Private Sub QueryProcess()
Dim DBConn
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim rngColumn As Excel.Range
Dim rngCell As Excel.Range
Dim strSource As String
Dim mysheet As String
Dim lngRow As Long
ProgressBar2.Value = 1
ProgressBar2.Value = 10
ProgressBar2.Value = 20
ProgressBar2.Value = 30

Dim rs
'This is Adaptive Server Enterprise Connection
Set DBConn = CreateObject("ADODB.Connection")
DBConn.Open "ODBC; Driver=Adaptive Server Anywhere 6.0; DSN=Debtmaster; uid=dm; pwd=,,PeAches..;"
Dim sSQL As String
sSQL = "select clt_ref_no as CFG_ACCOUNT, " & _
"(case  " & _
"when r.status_code in ('400','404','407') then 'OVBK' " & _
"when r.status_code in ('210','420','430','470','630') then 'OVUN' " & _
"when r.status_code in ('435') then 'OVRC' " & _
"when r.status_code in ('450') then 'OVDC' " & _
"when r.status_code in ('487','485') then 'OVFA' " & _
"when r.status_code = '491' then 'OCAC' " & _
"when r.status_code = '510' then 'OSIF' " & _
"when r.status_code='520' then 'OPIF' " & _
"else 'CHECK STATUS' " & _
"END) as REASON, " & _
"(SELECT LONGSTR FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND LABEL='BANKRUPTCYCHAPTER' and reason='OVBK') AS BANKRUPTCYCHAPTER, " & _
"(SELECT LONGSTR FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND LABEL='CASENUMBER' and reason='OVBK') AS CASENUM, " & _
"CONVERT(CHAR(10),(SELECT DATE1 FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID and reason='OVBK' AND LABEL='FILEDATE'),101) AS BKTFILEDATE, " & _
"CONVERT(CHAR(10),(SELECT DATE1 FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID and reason='OVBK' AND LABEL='DECEASEDDATE'),101) AS DATEOFDEATH, " & _
"STATUS_DESCR AS COMMENTS, " & _
"    substring(DEBT_DESCR,(LOCATE(DEBT_DESCR,':',1)+1), 30) AS ORIGINALACCOUNT " & _
"FROM DEBT_VIEW S JOIN DBTR R ON S.DEBT_ID=R.DEBTOR_ID " & _
"WHERE CLT_ID LIKE 'IDTC%' AND R.STATUS_CODE>='400'  AND R.STATUS_DATE>'2007-02-25' "

Set rs = DBConn.Execute(sSQL)

strSource = "\\usnymel1fs001\new claims\IDT Carmel\upload\" & "Close And Returns File" & " " & Format(Date, "MMDDYY") & ".xls"
Set xlApp = New Excel.Application
'Set xlWb = xlApp.Workbooks.Open(strSource)
Set xlWb = xlApp.Workbooks.Add 'this creates a new, blank workbook
mysheet = xlApp.Worksheets(1).Name
xlApp.Columns("A:H").EntireColumn.AutoFit
Set xlWS = xlWb.Worksheets(mysheet)
xlWS.Range("A1").Value = "CFG_ACCOUNT"
xlWS.Range("B1").Value = "STATUS"
xlWS.Range("C1").Value = "BKT CAHPTER"
xlWS.Range("D1").Value = "BKT CASE#"
xlWS.Range("E1").Value = "BKT FILE DATE"
xlWS.Range("F1").Value = "DATE OF DEATH"
xlWS.Range("G1").Value = "COMMENTS"
xlWS.Range("H1").Value = "ORIGINAL ACCOUNT"
lngRow = 2
Do While Not rs.EOF
    If ProgressBar2.Value >= 100 Then ProgressBar2.Value = 0
    ProgressBar2.Value = ProgressBar2.Value + 1
    xlWS.Cells(lngRow, 1).Value = rs!CFG_ACCOUNT
    xlWS.Cells(lngRow, 2).Value = rs!REASON
    xlWS.Cells(lngRow, 3).Value = rs!BANKRUPTCYCHAPTER
    xlWS.Cells(lngRow, 4).Value = rs!CASENUM
    xlWS.Cells(lngRow, 5).Value = rs!BKTFILEDATE
    xlWS.Cells(lngRow, 6).Value = rs!DATEOFDEATH
    xlWS.Cells(lngRow, 7).Value = rs!Comments
    xlWS.Cells(lngRow, 8).Value = rs!ORIGINALACCOUNT
    lngRow = lngRow + 1
    rs.MoveNext
Loop

xlWb.Close SaveChanges:=True, FileName:=strSource
Set xlWb = Nothing
Set xlWS = Nothing
xlApp.Quit
Set xlApp = Nothing
Unload Me
ShellExecute 0, vbNullString, Chr(34) & strSource & Chr(34), vbNullString, strSource, vbMaximizedFocus
End Sub
mustish1Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

TreyHCommented:
If you want the progress bar to reflect moving through the recordset then you could do something like this:


ProgressBar2.Min = 1
ProgressBar2.Max = rs.RecordCount
ProgressBar2.Value = 0

Do While Not rs.EOF

    If ProgressBar2.Value < ProgressBar2.Max Then
      ProgressBar2.Value = ProgressBar2.Value + 1
    End If

    ProgressBar2.Value = ProgressBar2.Value + 1
    xlWS.Cells(lngRow, 1).Value = rs!CFG_ACCOUNT
    xlWS.Cells(lngRow, 2).Value = rs!REASON
    xlWS.Cells(lngRow, 3).Value = rs!BANKRUPTCYCHAPTER
    xlWS.Cells(lngRow, 4).Value = rs!CASENUM
    xlWS.Cells(lngRow, 5).Value = rs!BKTFILEDATE
    xlWS.Cells(lngRow, 6).Value = rs!DATEOFDEATH
    xlWS.Cells(lngRow, 7).Value = rs!Comments
    xlWS.Cells(lngRow, 8).Value = rs!ORIGINALACCOUNT
    lngRow = lngRow + 1
    rs.MoveNext
Loop
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
mustish1Author Commented:
Thanks. Can you also please tell me how to i show the estimated time with the bar?
0
Guy Hengel [angelIII / a3]Billing EngineerCommented:
note: you need a Doevents call in the loop to give the progressbar the chance to refresh, otherwise you won't see anything.

>Can you also please tell me how to i show the estimated time with the bar?
there are several techniques.
* don't use a progress bar.
* progress up to 50% with incrementing by 1 for each record, then starting incrementing only by 0.5 until 80%, then only by 0.20 until 90% etc...
* get the exact number of records to be processed, that way you are sure that the progressbar.max is correct.



0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.