Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

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

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

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

'---- only update every 1000 records.

if c/1000=int(c/1000) then

Form_CheckForUpdates.Progr

DoEvents

end if

Loop

Close #1

Close #2

Form_CheckForUpdates.Capti

End Function

Dim tmpchr As String * 1024

Dim I As Long: I=(flen Mod 1024)

Dim finalchr As String * I

Does that work?

"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

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

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

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

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.

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.Progr

DoEvents

Next

End If

If (flen Mod 1024)<>0 Then

Get#1, , finalchr

Put#2, , finalchr

End If

Close #1

Close #2