Results 1 to 11 of 11

Thread: Copy Large File by Chunk with Progress Notification

  1. #1

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    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
    • Don't forget to use [CODE]your code here[/CODE] when posting code
    • If your question was answered please use Thread Tools to mark your thread [RESOLVED]
    • Don't forget to RATE helpful posts

    • Baby Steps a guided tour
    • IsDigits() and IsNumber() functions • Wichmann-Hill Random() function • >> and << functions for VB • CopyFileByChunk

  2. #2
    Member
    Join Date
    Feb 2010
    Posts
    55

    Re: Copy Large File by Chunk with Progress Notification

    Quote Originally Posted by anhn View Post
    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.

  3. #3

    Thread Starter
    Head Hunted anhn's Avatar
    Join Date
    Aug 2007
    Location
    Australia
    Posts
    3,669

    Re: Copy Large File by Chunk with Progress Notification

    Instead of 2 lines of code:

    Debug.Print SoFar, Format(SoFar / FileSize, "0.0&#37;")

    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.
    • Don't forget to use [CODE]your code here[/CODE] when posting code
    • If your question was answered please use Thread Tools to mark your thread [RESOLVED]
    • Don't forget to RATE helpful posts

    • Baby Steps a guided tour
    • IsDigits() and IsNumber() functions • Wichmann-Hill Random() function • >> and << functions for VB • CopyFileByChunk

  4. #4
    Registered User
    Join Date
    Oct 2020
    Posts
    1

    Re: Copy Large File by Chunk with Progress Notification

    Quote Originally Posted by anhn View Post
    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?

  5. #5
    Member
    Join Date
    Feb 2022
    Location
    Italy
    Posts
    56

    Re: Copy Large File by Chunk with Progress Notification

    Quote Originally Posted by yusuf78 View Post
    How about this code in VB7 / 64 bit version?
    VB7? This really exsist? What are you talking about?

  6. #6
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,854

    Re: Copy Large File by Chunk with Progress Notification

    There is no VB7
    Maybe yusuf78 is referring to VB.Net

  7. #7
    Hyperactive Member
    Join Date
    Nov 2011
    Posts
    498

    Re: Copy Large File by Chunk with Progress Notification

    Quote Originally Posted by anhn View Post
    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?

  8. #8
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,092

    Re: Copy Large File by Chunk with Progress Notification

    Quote Originally Posted by k_zeon View Post
    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>

  9. #9
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

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

  10. #10
    Member
    Join Date
    Feb 2022
    Location
    Italy
    Posts
    56

    Re: Copy Large File by Chunk with Progress Notification

    Quote Originally Posted by fafalone View Post
    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

  11. #11

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width