Solved

File Copy Progress

Posted on 2004-08-26
18
386 Views
Last Modified: 2012-08-14
This is the deal, I have form that downloads a file from a remote server (this works 100% fine), but the file is fairly big so i have decided i would like to see the progress the file is making i want to have a ProgressBar Control on my form which shows the progress of the file copy (dir!), I fouind the code below but it was shockingly slow. there is only 1 file that has to copy.

Public Function CopyFileProgress3(sSrcFile As String, sDestFile As String, lTotalLen As Long, lBlock As Long)

'Form_CheckForUpdates.Show
'Form_CheckForUpdates.Caption = "Copying..."

Dim filetocopy As String: filetocopy = sSrcFile
Dim newfile As String: newfile = sDestFile

Open filetocopy For Binary As #1
Open newfile For Binary As #2

Dim flen As Long: flen = FileLen(filetocopy)

If flen = 0 Then
    MsgBox "File is either empty or does not exist!"
    Close #1
    Close #2
    Exit Function
End If

Form_CheckForUpdates.ProgressBar.Min = 0
Form_CheckForUpdates.ProgressBar.Max = flen
Form_CheckForUpdates.ProgressBar.Value = 0

Dim c As Long: c = 0
Dim tmpchr As String * 1

Do While c < flen
    Get #1, , tmpchr
    Put #2, , tmpchr

    c = c + 1
    Form_CheckForUpdates.ProgressBar = c
    DoEvents
Loop

Close #1
Close #2

Form_CheckForUpdates.Caption = "Finished"
End Function
0
Comment
Question by:Y2Kingswood
  • 7
  • 6
  • 4
18 Comments
 
LVL 41

Accepted Solution

by:
shanesuebsahakarn earned 25 total points
ID: 11909858
Non-trivial. You can certainly alter the code above to read say in 1K blocks rather than 1-byte blocks though. If you want a progress bar, you'll have to largely follow the code methodology above.

e.g.
Dim tmpchr As String * 1024
Dim finalchr As String * (flen Mod 1024)
Dim I As Long

If flen>=1024 Then
   For I=1 To (flen\1024)
       Get #1, , tmpchr
       Put #2, , tmpchr

       c = c + 1024
       Form_CheckForUpdates.ProgressBar = c
       DoEvents
   Next
End If
If (flen Mod 1024)<>0 Then
   Get#1, , finalchr
   Put#2, , finalchr
End If

Close #1
Close #2
0
 

Author Comment

by:Y2Kingswood
ID: 11909870
Dim finalchr As String * (flen Mod 1024) has an incorrect syntax
0
 
LVL 7

Assisted Solution

by:rockmuncher
rockmuncher earned 25 total points
ID: 11909880
Your sample code updates the progress bar with every write.  You might be able to speed things up a little by updating the progress bar less often:

Public Function CopyFileProgress3(sSrcFile As String, sDestFile As String, lTotalLen As Long, lBlock As Long)

'Form_CheckForUpdates.Show
'Form_CheckForUpdates.Caption = "Copying..."

Dim filetocopy As String: filetocopy = sSrcFile
Dim newfile As String: newfile = sDestFile

Open filetocopy For Binary As #1
Open newfile For Binary As #2

Dim flen As Long: flen = FileLen(filetocopy)


If flen = 0 Then
    MsgBox "File is either empty or does not exist!"
    Close #1
    Close #2
    Exit Function
End If

Form_CheckForUpdates.ProgressBar.Min = 0
Form_CheckForUpdates.ProgressBar.Max = flen
Form_CheckForUpdates.ProgressBar.Value = 0

Dim c As Long: c = 0
Dim tmpchr As String * 1

Do While c < flen
    Get #1, , tmpchr
    Put #2, , tmpchr

    c = c + 1

    '---- only update every 1000 records.
    if c/1000=int(c/1000) then
       Form_CheckForUpdates.ProgressBar = c
       DoEvents
    end if

Loop

Close #1
Close #2

Form_CheckForUpdates.Caption = "Finished"
End Function
0
Ransomware: The New Cyber Threat & How to Stop It

This infographic explains ransomware, type of malware that blocks access to your files or your systems and holds them hostage until a ransom is paid. It also examines the different types of ransomware and explains what you can do to thwart this sinister online threat.  

 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 11909883
Hmm, do this:
Dim tmpchr As String * 1024
Dim I As Long: I=(flen Mod 1024)
Dim finalchr As String * I

Does that work?
0
 

Author Comment

by:Y2Kingswood
ID: 11909908
now i get
"Consistant expression required on line "Dim finalchr As String * I"

Public Function CopyFileProgress3(sSrcFile As String, sDestFile As String, lTotalLen As Long, lBlock As Long)

Dim filetocopy As String: filetocopy = sSrcFile
Dim newfile As String: newfile = sDestFile

Open filetocopy For Binary As #1
Open newfile For Binary As #2

Dim flen As Long: flen = FileLen(filetocopy)

If flen = 0 Then
    MsgBox "File is either empty or does not exist!"
    Close #1
    Close #2
    Exit Function
End If

Form_CheckForUpdates.ProgressBar.Min = 0
Form_CheckForUpdates.ProgressBar.Max = flen
Form_CheckForUpdates.ProgressBar.Value = 0

Dim c As Long: c = 0
Dim tmpchr As String * 1024
Dim I As Long: I = (flen Mod 1024)
Dim finalchr As String * I

If flen >= 1024 Then
   For I = 1 To (flen \ 1024)
       Get #1, , tmpchr
       Put #2, , tmpchr

       c = c + 1024
       Form_CheckForUpdates.ProgressBar = c
       DoEvents
   Next
End If
If (flen Mod 1024) <> 0 Then
   Get #1, , finalchr
   Put #2, , finalchr
End If

Close #1
Close #2

Form_CheckForUpdates.Caption = "Finished"
End Function
0
 
LVL 7

Expert Comment

by:rockmuncher
ID: 11909958
I believe 'I' would need to be declared as a constant rather than a variable for that to work.

Dim c As Long: c = 0
Dim tmpchr As String * 1024
Dim I As Long: I = (flen Mod 1024)    <----- replace this line
Dim finalchr As String * I

with this:

Const I=(flen Mod 1024) As Long


0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 11909976
rockmuncher is right, but use a different variable than "I" - I've reused "I" later on in the procedure as a loop control variable.
0
 

Author Comment

by:Y2Kingswood
ID: 11909980
replaced, Dim I As Long: I = (flen Mod 1024) with Const I=(flen Mod 1024) As Long ?

that didnt work so i did this

replaced, Dim I As Long: I = (flen Mod 1024) with Const I = (flen Mod 1024)
and now i get "contant expression required" and it highlights "flen"

Ive gotta head off now, but i will check back after the week end.
Thanks for you all your help thus far. if i get a chance to do some work on the week end i'll let u know
0
 

Author Comment

by:Y2Kingswood
ID: 11909984
Same thing when i change it to somthing other than "I"

Current Code:

Public Function CopyFileProgress3(sSrcFile As String, sDestFile As String, lTotalLen As Long, lBlock As Long)

Dim filetocopy As String: filetocopy = sSrcFile
Dim newfile As String: newfile = sDestFile

Open filetocopy For Binary As #1
Open newfile For Binary As #2

Dim flen As Long: flen = FileLen(filetocopy)

If flen = 0 Then
    MsgBox "File is either empty or does not exist!"
    Close #1
    Close #2
    Exit Function
End If

Form_CheckForUpdates.ProgressBar.Min = 0
Form_CheckForUpdates.ProgressBar.Max = flen
Form_CheckForUpdates.ProgressBar.Value = 0

Dim c As Long: c = 0
Dim tmpchr As String * 1024
Const S = (flen Mod 1024)
Dim finalchr As String * S

If flen >= 1024 Then
   For I = 1 To (flen \ 1024)
       Get #1, , tmpchr
       Put #2, , tmpchr

       c = c + 1024
       Form_CheckForUpdates.ProgressBar = c
       DoEvents
   Next
End If
If (flen Mod 1024) <> 0 Then
   Get #1, , finalchr
   Put #2, , finalchr
End If

Close #1
Close #2

Form_CheckForUpdates.Caption = "Finished"
End Function

0
 

Author Comment

by:Y2Kingswood
ID: 11909993
when i say replaced, Dim I As Long: I = (flen Mod 1024) with Const I=(flen Mod 1024) As Long didnt work i acttualy got the same error i had been getting before
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 11909998
OK, do this:
Dim finalchar As String
finalchar=String(flen Mod 1024," ")

That should work.
0
 
LVL 7

Expert Comment

by:rockmuncher
ID: 11910002
I'm still gunning for my original post: far simpler and achieves exactly the same effect as far as I can tell !   :)
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 11910025
Not quite - my modification also copies the data in 1024 byte chunks, reducing disk overhead. Without running a test, I have no idea though what is causing the bottleneck, whether it's the disk overhead or the progress bar update.
0
 

Author Comment

by:Y2Kingswood
ID: 11910029
you'll be pleased to know that clobbered the orginal file. and it also killed the backup of it as well. because access was trying to be smart so once it copied over the top it created a backup over the top of my current backup as well. so once i have spent countless hours remaking this i'll let you know. but for now im going home. Have a good week end
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 11910049
Hmm, sorry to hear that but it shouldn't have affected the original file as no writing is done to it - and it certainly shouldn't have affected a backup.
0
 
LVL 7

Expert Comment

by:rockmuncher
ID: 11910061
>> my modification also copies the data in 1024 byte chunks <<  I would have thought that the overhead of doing this in VBA would be far greater than letting the OS do the work it is intended to do.  Just a thought.
0
 
LVL 41

Expert Comment

by:shanesuebsahakarn
ID: 11910078
I suppose it depends on the network as well, but I'd really need to do some testing - it's conjecture otherwise. It could also be the call to DoEvents after every byte copy could well be the problem.
0

Featured Post

Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Copied Report Does not run on a different Query Source ? 7 34
Problem with vba code 4 45
Access 2016 - combo box 3 21
Count of values in access 2 11
The first two articles in this short series — Using a Criteria Form to Filter Records (http://www.experts-exchange.com/A_6069.html) and Building a Custom Filter (http://www.experts-exchange.com/A_6070.html) — discuss in some detail how a form can be…
In earlier versions of Windows (XP and before), you could drag a database to the taskbar, where it would appear as a taskbar icon to open that database.  This article shows how to recreate this functionality in Windows 7 through 10.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

807 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