Y2Kingswood
asked on
File Copy Progress
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.Capt ion = "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.Progr essBar.Min = 0
Form_CheckForUpdates.Progr essBar.Max = flen
Form_CheckForUpdates.Progr essBar.Val ue = 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.Progr essBar = c
DoEvents
Loop
Close #1
Close #2
Form_CheckForUpdates.Capti on = "Finished"
End Function
Public Function CopyFileProgress3(sSrcFile
'Form_CheckForUpdates.Show
'Form_CheckForUpdates.Capt
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.Progr
Form_CheckForUpdates.Progr
Form_CheckForUpdates.Progr
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.Progr
DoEvents
Loop
Close #1
Close #2
Form_CheckForUpdates.Capti
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Hmm, do this:
Dim tmpchr As String * 1024
Dim I As Long: I=(flen Mod 1024)
Dim finalchr As String * I
Does that work?
Dim tmpchr As String * 1024
Dim I As Long: I=(flen Mod 1024)
Dim finalchr As String * I
Does that work?
ASKER
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.Progr essBar.Min = 0
Form_CheckForUpdates.Progr essBar.Max = flen
Form_CheckForUpdates.Progr essBar.Val ue = 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.Progr essBar = 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.Capti on = "Finished"
End Function
"Consistant expression required on line "Dim finalchr As String * I"
Public Function CopyFileProgress3(sSrcFile
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.Progr
Form_CheckForUpdates.Progr
Form_CheckForUpdates.Progr
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.Progr
DoEvents
Next
End If
If (flen Mod 1024) <> 0 Then
Get #1, , finalchr
Put #2, , finalchr
End If
Close #1
Close #2
Form_CheckForUpdates.Capti
End Function
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
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
rockmuncher is right, but use a different variable than "I" - I've reused "I" later on in the procedure as a loop control variable.
ASKER
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
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
ASKER
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.Progr essBar.Min = 0
Form_CheckForUpdates.Progr essBar.Max = flen
Form_CheckForUpdates.Progr essBar.Val ue = 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.Progr essBar = 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.Capti on = "Finished"
End Function
Current Code:
Public Function CopyFileProgress3(sSrcFile
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.Progr
Form_CheckForUpdates.Progr
Form_CheckForUpdates.Progr
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.Progr
DoEvents
Next
End If
If (flen Mod 1024) <> 0 Then
Get #1, , finalchr
Put #2, , finalchr
End If
Close #1
Close #2
Form_CheckForUpdates.Capti
End Function
ASKER
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
OK, do this:
Dim finalchar As String
finalchar=String(flen Mod 1024," ")
That should work.
Dim finalchar As String
finalchar=String(flen Mod 1024," ")
That should work.
I'm still gunning for my original post: far simpler and achieves exactly the same effect as far as I can tell ! :)
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.
ASKER
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
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.
>> 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.
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.
ASKER