dcsimg
Results 1 to 3 of 3

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

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width