We help IT Professionals succeed at work.

Progress bar help???

Ahelbling
Ahelbling asked
on
222 Views
Last Modified: 2012-05-05
I have never messed with progress bars before, and after some research, I am confused.  Can someone help to show me the proper way to add a progress bar to this code? This utlility reads data from a txt file and writes the data to an Access 2000 DB. I would like to add a progress bar to the form for the users.

CODE:

Dim intFN As Integer
Dim strMemNum As String
Dim strAmt As String
Dim sngAmt As Single
Dim strDescription As String
Dim strLine As String

Private Sub cmdClose_Click()
VB.Unload Me
End Sub

Private Sub cmdRunRejects_Click()

cmdRunRejects.Enabled = False
txtCaption.Text = ""
frmRunRejects.Refresh

intFN = FreeFile
Open "C:\Program Files\Helios11\Arnold.txt" For Input As #intFN
Do Until EOF(intFN)
    Do
        'look for "MEMBER #"
        Line Input #intFN, strLine
        If InStr(1, strLine, "MEMBER #", vbTextCompare) = 1 Then
            Line Input #intFN, strLine
            Exit Do
        End If
    Loop
   
    Do
        strMemNum = Trim(Mid$(strLine, 1, 16))
        strAmt = Trim(Mid$(strLine, 57, 7))
        sngAmt = CSng(strAmt)
        strDescription = Trim(Mid$(strLine, 64, 60))
       
       
        Call ListTables("Link.mdb")
        'update and insert values into database tables
        'for testing Debug.Print "upd/isrt", strMemNum, strAmt, sngAmt, strDescription
       
       
       
        Line Input #intFN, strLine
        If Left$(strLine, 1) = " " Then
            Exit Do
        End If
    Loop
Loop
Close
txtCaption.Text = "Credit Cards rejects imported into Helios."

cmdClose.Enabled = True
End Sub

Private Sub Form_Load()
cmdClose.Enabled = False
txtCaption.Text = "Click button above to import rejects."
End Sub

Private Sub ListTables(ByVal db_name As String)
Dim statement As String
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset

    Set conn = New ADODB.Connection
   
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Persist Security Info = False;" & _
        "Data Source=C:\Program Files\Helios11\Data\Link.mdb"
    conn.Open
   
    'On Error Resume Next
 
    Set rs = conn.OpenSchema(adSchemaTables, _
        Array(Empty, Empty, Empty, "Table"))
        conn.Execute "update client_profile set balance = balance + " & strAmt & " where client_no = " & strMemNum
        conn.Execute "insert into notes (client_no, comments, empcode, interrupt, deleted, last_mdt) values (" & strMemNum & ",'" & strDescription & "', 'EFT',-1,0,now())"
    rs.Close
         
    conn.Close
       
End Sub


TIA,
Andrew
Comment
Watch Question

jkaiosIT Director

Commented:
In the subroutine where you open and read the text file, that's where you code the Progress bar (simply increment the Value property as you loop thru the file).
Just add the Microsoft Windows Common Controls 6.0 or 5.0 from the Components list.

Private Sub cmdRunRejects_Click()

cmdRunRejects.Enabled = False
txtCaption.Text = ""
frmRunRejects.Refresh

intFN = FreeFile
Open "C:\Program Files\Helios11\Arnold.txt" For Input As #intFN

 Dim ii&, xx$
 
 Seek intFN, 1                  '<-- Go to the first line in file
 Do While Not EOF(intFN)
   DoEvents
   ii = ii + 1
   Line Input #intFN, xx      '<-- Read each line thru
 Loop
 Seek intFN, 1                   '<-- Reposition on the first line
 
ProgressBar1.Max = ii       '<-- Set progressbar max property to number of lines/records in text file
ProgressBar1.Value = 0    '<-- Initialize its value to zero

Do Until EOF(intFN)

    ProgressBar1.Value = ProgressBar1.Value + 1      '<-- AS YOU LOOP THRU THE FILE, YOU INCREMENT THE PROGRESS BAR VALUE BY 1
    DoEvents

    Do
        'look for "MEMBER #"
        Line Input #intFN, strLine
        If InStr(1, strLine, "MEMBER #", vbTextCompare) = 1 Then
            Line Input #intFN, strLine
            Exit Do
        End If
    Loop
   
    Do
        strMemNum = Trim(Mid$(strLine, 1, 16))
        strAmt = Trim(Mid$(strLine, 57, 7))
        sngAmt = CSng(strAmt)
        strDescription = Trim(Mid$(strLine, 64, 60))
       
        Call ListTables("Link.mdb")
        'update and insert values into database tables
        'for testing Debug.Print "upd/isrt", strMemNum, strAmt, sngAmt, strDescription
       
        Line Input #intFN, strLine
        If Left$(strLine, 1) = " " Then
            Exit Do
        End If
    Loop

Loop

Close
txtCaption.Text = "Credit Cards rejects imported into Helios."
cmdClose.Enabled = True

End Sub

Author

Commented:
it is showing just one bar in the progress bar on the form, then finishes the process without filling up the whole bar?
jkaiosIT Director

Commented:
That is because of the way you loop thru the file in which you did 2 additional (nested) loops, and in those nested loops you then read the file.
In order for the progress bar to increment properly, you have to read each line from the text file in the main loop, not in the nested loops.

So, remove the 2 nested loops and just keep the main loop.  I don't see the need to construct 2 additional loops inside the main loop to get the data you want (which in your case "MEMBER #").

Here, try this revised version of your loop:

'=======================================================
Do Until EOF(intFN)                 '<-- THIS IS YOUR MAIN LOOP

    ProgressBar1.Value = ProgressBar1.Value + 1
    DoEvents

    Line Input #intFN, strLine    '<-- This will read the current line from the text file into the variable and then automatically advance to the next line
                                            '<-- You don't need to call/construct any additional loops.  The data is in the strLine variable.  All you have to do is check
                                            '<-- it to see if the "MEMBER #" string in in that line.  If not, then VB will advance to the next line and do the same thing.
    If Left$(strLine, 1) <> " " Then
       
       If InStr(1, strLine, "MEMBER #", vbTextCompare) = 1 Then
          strMemNum = Trim(Mid$(strLine, 1, 16))
          strAmt = Trim(Mid$(strLine, 57, 7))
          sngAmt = CSng(strAmt)
          strDescription = Trim(Mid$(strLine, 64, 60))
         
          Call ListTables("Link.mdb")
          'update and insert values into database tables
          'for testing Debug.Print "upd/isrt", strMemNum, strAmt, sngAmt, strDescription
       End If
       
    End If

Loop
'=======================================================

Author

Commented:
now I get a type mismatch error:

sngAmt = CSng(strAmt)
jkaiosIT Director

Commented:
Use the Val() function instead.

sngAmt = Val(strAmt)

Author

Commented:
progress bar still sits on 1 bar and never completes?


Private Sub cmdRunRejects_Click()

cmdRunRejects.Enabled = False
lblCaption.Caption = ""
frmRunRejects.Refresh

    ' This first group of commands invokes the Open Dialog
    ' and display the Open dialog (#1)
    CommonDialog1.Filter = "Text files (*.txt)|*.txt|All Files (*.*)|*.*"
    CommonDialog1.ShowOpen

    ' then get the resulting filename
    FileName = CommonDialog1.FileName
   
    ' this error simply exits if user Cancels from Open Dialog
    'OpenErr1:
    'cmdRunRejects.Enabled = True
    'lblCaption.Caption = "Click button above to import rejects."
    'Exit Sub


intFN = FreeFile
Open FileName For Input As #intFN

 Dim ii&, xx$
 
 Seek intFN, 1                  '<-- Go to the first line in file
 Do While Not EOF(intFN)
   DoEvents
   ii = ii + 1
   Line Input #intFN, xx      '<-- Read each line thru
 Loop
 Seek intFN, 1                   '<-- Reposition on the first line
 
ProgressBar1.Max = ii      '<-- Set progressbar max property to number of lines/records in text file
ProgressBar1.Value = 0    '<-- Initialize its value to zero
Counter1 = 0

Do Until EOF(intFN)

    ProgressBar1.Value = ProgressBar1.Value + 1      '<-- AS YOU LOOP THRU THE FILE, YOU INCREMENT THE PROGRESS BAR VALUE BY 1
   
    lblCaption.Caption = "Processing..."
    DoEvents
    frmRunRejects.Refresh

    Do
        'look for "MEMBER #"
        Line Input #intFN, strLine
        If InStr(1, strLine, "MEMBER #", vbTextCompare) = 1 Then
            Line Input #intFN, strLine
            Exit Do
        End If
    Loop
   
    Do
        strMemNum = Trim(Mid$(strLine, 1, 16))
        strAmt = Trim(Mid$(strLine, 57, 7))
        sngAmt = Val(strAmt)
        strDescription = Trim(Mid$(strLine, 64, 60))
       
        'update and insert values into database tables
        Call ListTables("Link.mdb")
               
        Line Input #intFN, strLine
        If Left$(strLine, 1) = " " Then
            Exit Do
        End If
    Loop

Loop

Close

Kill FileName

lblCaption.Caption = "Done."
cmdClose.Enabled = True

End Sub
IT Director
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.