Solved

Progress Bar

Posted on 2008-06-12
3
263 Views
Last Modified: 2011-09-20
Hello all,
I was create a program that copy files to a destination folder. I need to add a progress bar in form that can see when copy files complete and one label that can show the % of the progress done.

From a commandbutton I call the attach code (sub)
Call FindFiles(txtSourceFolder.Text, "_a.txt", txtDestFolder.Text, "_b.txt", CDate(DtpFrom.Value), CDate(DtpTo.Value), txtCustomer.Text)

Can be help me anyone. Thanks
Sub FindFiles(strFolder As String, strFilePatternA As String, strDestFolder As String, _

           strFilePatternB As String, dtStart As Date, dtEnd As Date, strSearchText As String)

    Dim strSourceFile As String

    Dim strDestFile As String

    Dim strSubFolder As String

    Dim strFolders() As String

    Dim strText As String

    Dim f As Integer

    Dim i As Integer

    Dim strFile As String

    

    strSourceFile = Dir$(strFolder & "\*" & strFilePatternA)

    Do Until strSourceFile = ""

            DoEvents

            If FileDateTime(strFolder & "\" & strSourceFile) >= dtStart And _

                FileDateTime(strFolder & "\" & strSourceFile) <= dtEnd Then

                f = FreeFile

                Open strFolder & "\" & strSourceFile For Binary As #f

                strText = String(LOF(f), " ")

                Get #f, , strText

                If InStr(strText, strSearchText) > 0 Then

                    Close #f

                    FileCopy strFolder & "\" & strSourceFile, strDestFolder & "\" & strSourceFile

                    strDestFile = Left$(strSourceFile, Len(strSourceFile) - Len(strFilePatternA)) _

                                                 & strFilePatternB

                    FileCopy strFolder & "\" & strDestFile, strDestFolder & "\" & strDestFile

                End If

            End If

        strSourceFile = Dir$()

    Loop

    

    i = -1

    strSubFolder = Dir$(strFolder & "\*", vbDirectory)

    Do Until strSubFolder = ""

        If Left$(strSubFolder, 1) <> "." Then

            If (GetAttr(strFolder & "\" & strSubFolder) And vbDirectory) = vbDirectory Then

                i = i + 1

                ReDim Preserve strFolders(i)

                strFolders(i) = strFolder & "\" & strSubFolder

            End If

        End If

        strSubFolder = Dir$()

    Loop

    

    If i > -1 Then

    For i = 0 To UBound(strFolders)

    FindFiles strFolders(i), strFilePatternA, strDestFolder, strFilePatternB, dtStart, _

                       dtEnd, strSearchText

    Next i

    End If

End Sub

Open in new window

0
Comment
Question by:fkourou
3 Comments
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 21771991
You can use the windows API to setup a callback routine that can be used to setup a progress

FileCopyEx
http://msdn.microsoft.com/en-us/library/aa363852(VS.85).aspx
CopyProgressRoutine Callback Function
http://msdn.microsoft.com/en-us/library/aa363854(VS.85).aspx
0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 250 total points
ID: 21772551
You need to Find how much work there is to be done so that the progress bar shows the what proportion has been done at any moment.

There is a possibility that finding that information will take as much time as the actual work, so this doesn't open the possible target files, so the count will include files which aren't actually copied.
You need to include a line in the original code:

            If FileDateTime(strFolder & "\" & strSourceFile) >= dtStart And _
                FileDateTime(strFolder & "\" & strSourceFile) <= dtEnd Then
                ProgressBar1.Value = ProgressBar1.Value + 1 '<--extra line
                f = FreeFile
 


The Function in the snippet is a modification of the FindFiles Sub. It counts all the candidate files without opening them.

Call the two procedures like this:


ProgressBar1.Max = CountFiles( "C:\MyFolder", "_a.txt", "C:\Backup", "_b.text", CDate("20/04/2008"), CDate("26/04/2008"), "3000367648")

ProgressBar1.Value = 0
  FindFiles "C:\MyFolder", "_a.txt", "C:\Backup", "_b.text", CDate("20/04/2008"), CDate("26/04/2008"), "3000367648"
Function CountFiles(strFolder As String, strFilePatternA As String, strDestFolder As String, _

        strFilePatternB As String, dtStart As Date, dtEnd As Date, strSearchText As String) As Integer

    Dim strSourceFile As String

    Dim strDestFile As String

    Dim strSubFolder As String

    Dim strFolders() As String

    Dim strText As String

    Dim f As Integer

    Dim i As Integer

    Dim strFile As String

    

    strSourceFile = Dir$(strFolder & "\*" & strFilePatternA)

    Do Until strSourceFile = ""

            DoEvents

            If FileDateTime(strFolder & "\" & strSourceFile) >= dtStart And _

                FileDateTime(strFolder & "\" & strSourceFile) <= dtEnd Then

                CountFiles = CountFiles + 1

            End If

        strSourceFile = Dir$()

    Loop

    

    i = -1

    strSubFolder = Dir$(strFolder & "\*", vbDirectory)

    Do Until strSubFolder = ""

        If Left$(strSubFolder, 1) <> "." Then

            If (GetAttr(strFolder & "\" & strSubFolder) And vbDirectory) = vbDirectory Then

                i = i + 1

                ReDim Preserve strFolders(i)

                strFolders(i) = strFolder & "\" & strSubFolder

            End If

        End If

        strSubFolder = Dir$()

    Loop

    

    If i > -1 Then

        For i = 0 To UBound(strFolders)

            CountFiles = CountFiles + CountFiles(strFolders(i), strFilePatternA, strDestFolder, strFilePatternB, dtStart, _

                           dtEnd, strSearchText)

        Next i

    End If

End Function

Open in new window

0
 

Author Closing Comment

by:fkourou
ID: 31466627
I dont khow why It is not running.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now