Copy Large File by Chunk with Progress Notification
When using FileCopy() to copy large file (particular over network), your project may looks like "Not Responding" or hang.
This single function can be used to copy file by chunk with progress notification between chunk. It can be used anywhere for VB6/VBA projects.
If required, a cancel feature of the copy process can be built-in with a Public Boolean flag.
Code:
Function CopyFileByChunk(sSource As String, sDestination As String, _
Optional ByVal ChunkSize As Long) As Long
Dim FileSize As Long, OddSize As Long, SoFar As Long
Dim Buffer() As Byte, f1 As Integer, f2 As Integer
Const MaxChunkSize As Long = 2 * 2 ^ 20 '-- 2MB
On Error GoTo CopyFileByChunk_Error
f1 = FreeFile: Open sSource For Binary Access Read As #f1
'-- create a blank file, existing file will be overitten
f2 = FreeFile: Open sDestination For Output As #f2: Close #f2
FileSize = LOF(f1)
If FileSize = 0 Then GoTo Exit_CopyFileByChunk ' -- done!
f2 = FreeFile: Open sDestination For Binary Access Write As #f2
If ChunkSize <= 0 Then ChunkSize = FileSize \ 100 '-- approx 1%
If ChunkSize = 0 Then
OddSize = FileSize
Else
If ChunkSize > MaxChunkSize Then ChunkSize = MaxChunkSize
OddSize = FileSize Mod ChunkSize
End If
If OddSize Then
ReDim Buffer(1 To OddSize)
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = OddSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
End If
If ChunkSize Then
ReDim Buffer(1 To ChunkSize)
Do While SoFar < FileSize
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = SoFar + ChunkSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
Loop
End If
CopyFileByChunk = LOF(f2)
If CopyFileByChunk <> FileSize Then
CopyFileByChunk = -CopyFileByChunk '-- negative denotes error
End If
Exit_CopyFileByChunk:
Close #f1
Close #f2
Exit Function
CopyFileByChunk_Error:
MsgBox "Runtime error " & Err.Number & ":" & vbCrLf & Err.Description, _
vbCritical, "CopyFileByChunk"
CopyFileByChunk = -1 '-- negative denotes error
Resume Exit_CopyFileByChunk
End Function
Code:
Sub Usage_CopyFileByChunk()
Dim sFileName As String, sSource As String, sDest As String
sFileName = "UNBILL.CSV"
sSource = "\\XyzServer\global\" & sFileName
sDest = "C:\MyFolder\" & sFileName
'Dim t As Single
't = Timer
'-- specify chunk size as 512KB:
Debug.Print CopyFileByChunk(sSource, sDest, 512 * 1024&)
'-- or use default chunk size of 1% file size:
'Debug.Print CopyFileByChunk(sSource, sDest)
'Debug.Print Timer - t
End Sub
Re: Copy Large File by Chunk with Progress Notification
Quote:
Originally Posted by
anhn
When using FileCopy() to copy large file (particular over network), your project may looks like "Not Responding" or hang.
This single function can be used to copy file by chunk with progress notification between chunk. It can be used anywhere for VB6/VBA projects.
If required, a cancel feature of the copy process can be built-in with a Public Boolean flag.
Code:
Function CopyFileByChunk(sSource As String, sDestination As String, _
Optional ByVal ChunkSize As Long) As Long
Dim FileSize As Long, OddSize As Long, SoFar As Long
Dim Buffer() As Byte, f1 As Integer, f2 As Integer
Const MaxChunkSize As Long = 2 * 2 ^ 20 '-- 2MB
On Error GoTo CopyFileByChunk_Error
f1 = FreeFile: Open sSource For Binary Access Read As #f1
'-- create a blank file, existing file will be overitten
f2 = FreeFile: Open sDestination For Output As #f2: Close #f2
FileSize = LOF(f1)
If FileSize = 0 Then GoTo Exit_CopyFileByChunk ' -- done!
f2 = FreeFile: Open sDestination For Binary Access Write As #f2
If ChunkSize <= 0 Then ChunkSize = FileSize \ 100 '-- approx 1%
If ChunkSize = 0 Then
OddSize = FileSize
Else
If ChunkSize > MaxChunkSize Then ChunkSize = MaxChunkSize
OddSize = FileSize Mod ChunkSize
End If
If OddSize Then
ReDim Buffer(1 To OddSize)
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = OddSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
End If
If ChunkSize Then
ReDim Buffer(1 To ChunkSize)
Do While SoFar < FileSize
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = SoFar + ChunkSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
Loop
End If
CopyFileByChunk = LOF(f2)
If CopyFileByChunk <> FileSize Then
CopyFileByChunk = -CopyFileByChunk '-- negative denotes error
End If
Exit_CopyFileByChunk:
Close #f1
Close #f2
Exit Function
CopyFileByChunk_Error:
MsgBox "Runtime error " & Err.Number & ":" & vbCrLf & Err.Description, _
vbCritical, "CopyFileByChunk"
CopyFileByChunk = -1 '-- negative denotes error
Resume Exit_CopyFileByChunk
End Function
Code:
Sub Usage_CopyFileByChunk()
Dim sFileName As String, sSource As String, sDest As String
sFileName = "UNBILL.CSV"
sSource = "\\XyzServer\global\" & sFileName
sDest = "C:\MyFolder\" & sFileName
'Dim t As Single
't = Timer
'-- specify chunk size as 512KB:
Debug.Print CopyFileByChunk(sSource, sDest, 512 * 1024&)
'-- or use default chunk size of 1% file size:
'Debug.Print CopyFileByChunk(sSource, sDest)
'Debug.Print Timer - t
End Sub
Thanks for giving me support,but i have to show file copy progress in progress bar
can u give me any suggestions.
Re: Copy Large File by Chunk with Progress Notification
Instead of 2 lines of code:
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
you can pass SoFar and FileSize to your progress bar.
Search to find an example on how to use progress bar in these forums or VB Help.
Re: Copy Large File by Chunk with Progress Notification
Quote:
Originally Posted by
anhn
When using FileCopy() to copy large file (particular over network), your project may looks like "Not Responding" or hang.
This single function can be used to copy file by chunk with progress notification between chunk. It can be used anywhere for VB6/VBA projects.
If required, a cancel feature of the copy process can be built-in with a Public Boolean flag.
Code:
Function CopyFileByChunk(sSource As String, sDestination As String, _
Optional ByVal ChunkSize As Long) As Long
Dim FileSize As Long, OddSize As Long, SoFar As Long
Dim Buffer() As Byte, f1 As Integer, f2 As Integer
Const MaxChunkSize As Long = 2 * 2 ^ 20 '-- 2MB
On Error GoTo CopyFileByChunk_Error
f1 = FreeFile: Open sSource For Binary Access Read As #f1
'-- create a blank file, existing file will be overitten
f2 = FreeFile: Open sDestination For Output As #f2: Close #f2
FileSize = LOF(f1)
If FileSize = 0 Then GoTo Exit_CopyFileByChunk ' -- done!
f2 = FreeFile: Open sDestination For Binary Access Write As #f2
If ChunkSize <= 0 Then ChunkSize = FileSize \ 100 '-- approx 1%
If ChunkSize = 0 Then
OddSize = FileSize
Else
If ChunkSize > MaxChunkSize Then ChunkSize = MaxChunkSize
OddSize = FileSize Mod ChunkSize
End If
If OddSize Then
ReDim Buffer(1 To OddSize)
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = OddSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
End If
If ChunkSize Then
ReDim Buffer(1 To ChunkSize)
Do While SoFar < FileSize
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = SoFar + ChunkSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
Loop
End If
CopyFileByChunk = LOF(f2)
If CopyFileByChunk <> FileSize Then
CopyFileByChunk = -CopyFileByChunk '-- negative denotes error
End If
Exit_CopyFileByChunk:
Close #f1
Close #f2
Exit Function
CopyFileByChunk_Error:
MsgBox "Runtime error " & Err.Number & ":" & vbCrLf & Err.Description, _
vbCritical, "CopyFileByChunk"
CopyFileByChunk = -1 '-- negative denotes error
Resume Exit_CopyFileByChunk
End Function
Code:
Sub Usage_CopyFileByChunk()
Dim sFileName As String, sSource As String, sDest As String
sFileName = "UNBILL.CSV"
sSource = "\\XyzServer\global\" & sFileName
sDest = "C:\MyFolder\" & sFileName
'Dim t As Single
't = Timer
'-- specify chunk size as 512KB:
Debug.Print CopyFileByChunk(sSource, sDest, 512 * 1024&)
'-- or use default chunk size of 1% file size:
'Debug.Print CopyFileByChunk(sSource, sDest)
'Debug.Print Timer - t
End Sub
How about this code in VB7 / 64 bit version?
Re: Copy Large File by Chunk with Progress Notification
Quote:
Originally Posted by
yusuf78
How about this code in VB7 / 64 bit version?
VB7? This really exsist? What are you talking about?
Re: Copy Large File by Chunk with Progress Notification
There is no VB7
Maybe yusuf78 is referring to VB.Net
Re: Copy Large File by Chunk with Progress Notification
Quote:
Originally Posted by
anhn
When using FileCopy() to copy large file (particular over network), your project may looks like "Not Responding" or hang.
This single function can be used to copy file by chunk with progress notification between chunk. It can be used anywhere for VB6/VBA projects.
If required, a cancel feature of the copy process can be built-in with a Public Boolean flag.
Code:
Function CopyFileByChunk(sSource As String, sDestination As String, _
Optional ByVal ChunkSize As Long) As Long
Dim FileSize As Long, OddSize As Long, SoFar As Long
Dim Buffer() As Byte, f1 As Integer, f2 As Integer
Const MaxChunkSize As Long = 2 * 2 ^ 20 '-- 2MB
On Error GoTo CopyFileByChunk_Error
f1 = FreeFile: Open sSource For Binary Access Read As #f1
'-- create a blank file, existing file will be overitten
f2 = FreeFile: Open sDestination For Output As #f2: Close #f2
FileSize = LOF(f1)
If FileSize = 0 Then GoTo Exit_CopyFileByChunk ' -- done!
f2 = FreeFile: Open sDestination For Binary Access Write As #f2
If ChunkSize <= 0 Then ChunkSize = FileSize \ 100 '-- approx 1%
If ChunkSize = 0 Then
OddSize = FileSize
Else
If ChunkSize > MaxChunkSize Then ChunkSize = MaxChunkSize
OddSize = FileSize Mod ChunkSize
End If
If OddSize Then
ReDim Buffer(1 To OddSize)
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = OddSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
End If
If ChunkSize Then
ReDim Buffer(1 To ChunkSize)
Do While SoFar < FileSize
Get #f1, , Buffer
Put #f2, , Buffer
SoFar = SoFar + ChunkSize
'-- replace with your way of progess notification such as
'Label1.Caption = SoFar & " bytes out of " & FileSize & " bytes: " & _
Format(SoFar / FileSize, "0.0%")
Debug.Print SoFar, Format(SoFar / FileSize, "0.0%")
DoEvents '-- if required
Loop
End If
CopyFileByChunk = LOF(f2)
If CopyFileByChunk <> FileSize Then
CopyFileByChunk = -CopyFileByChunk '-- negative denotes error
End If
Exit_CopyFileByChunk:
Close #f1
Close #f2
Exit Function
CopyFileByChunk_Error:
MsgBox "Runtime error " & Err.Number & ":" & vbCrLf & Err.Description, _
vbCritical, "CopyFileByChunk"
CopyFileByChunk = -1 '-- negative denotes error
Resume Exit_CopyFileByChunk
End Function
Code:
Sub Usage_CopyFileByChunk()
Dim sFileName As String, sSource As String, sDest As String
sFileName = "UNBILL.CSV"
sSource = "\\XyzServer\global\" & sFileName
sDest = "C:\MyFolder\" & sFileName
'Dim t As Single
't = Timer
'-- specify chunk size as 512KB:
Debug.Print CopyFileByChunk(sSource, sDest, 512 * 1024&)
'-- or use default chunk size of 1% file size:
'Debug.Print CopyFileByChunk(sSource, sDest)
'Debug.Print Timer - t
End Sub
will this still work with files over 2GB in size?
Re: Copy Large File by Chunk with Progress Notification
Quote:
Originally Posted by
k_zeon
will this still work with files over 2GB in size?
No, it will not work with files above 2GB in size and with long filenames too (above 260 symbols).
Try mdStreamSupport.bas instead with this sample implementation
Code:
Option Explicit
Private Sub Form_Load()
CopyFileByChunk "d:\temp\aaa.mkv", "d:\temp\bbb.mkv", 1024& * 1024
End Sub
Private Sub CopyFileByChunk( _
sSource As String, _
sDestination As String, _
Optional ByVal ChunkSize As Long = -1)
Dim pSrc As stdole.IUnknown
Dim pDest As stdole.IUnknown
Dim baBuffer() As Byte
Set pSrc = StreamOpenFile(sSource)
Set pDest = StreamOpenFile(sDestination, AlwaysCreate:=True)
Do While Not StreamEOF(pSrc)
StreamWriteBytes pDest, StreamReadBytes(pSrc, ChunkSize)
Loop
End Sub
cheers,
</wqw>
Re: Copy Large File by Chunk with Progress Notification
You can also hand it off to Windows and display the standard file move/copy dialog with SHFileOperation or the newer IFileOperation, both of which you can find code for in the forums (see my signature for a demo on the latter).
Re: Copy Large File by Chunk with Progress Notification
Quote:
Originally Posted by
fafalone
You can also hand it off to Windows and display the standard file move/copy dialog with SHFileOperation or the newer IFileOperation, both of which you can find code for in the forums (see my signature for a demo on the latter).
Hello farfalone,
I need to backup my vb6 application folder.
This folder contains many items (eg: pdf, images). This folder might be above 4/5gb
Now I'm using file copy but is too slow and sometimes there is a message of "Not Responding Application"
Can you share with me your example with IFileOPeration?
Many thanks
Re: Copy Large File by Chunk with Progress Notification
