Solved

Progress Bar

Posted on 2008-06-12
3
264 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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

920 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

20 Experts available now in Live!

Get 1:1 Help Now