Aşağıdaki kod parçası da yüzde ölçüsünü kullanarak dosya kopyalamaya yarıyor. Göze güzel görünen uygulamalar yapmak için iyi bir şey.

Function CopyFile (src As String, dst As String) As Single
'L. Serflaten 1996
 Static Buf$
 Dim BTest!, FSize!
 Dim Chunk%, F1%, F2%

 Const BUFSIZE = 1024

'This routine will copy a file while providing a means
'to support a percent gauge.  Ex. your display routine
'is called "PercentDone" and accepts the values 0-100.
'Error support is provided.
'
'A larger BUFSIZE is best, but do not attempt to exceed
'64 K (60000 would be fine)
'
'The size of the copied file is returned on success
'0 is returned on failure

   If Dir(src) = "" Then MsgBox "File not found": Exit Function
   If Len(Dir(dst)) Then
      If MsgBox(UCase(dst) & Chr(13) & Chr(10) & "File exists. Overwrite?", 4) <> 6 Then Exit Function
      Kill dst
   End If
 
   On Error GoTo FileCopyError
   F1 = FreeFile
   Open src For Binary As F1
   F2 = FreeFile
   Open dst For Binary As F2
 
   FSize = LOF(F1)
   BTest = FSize - LOF(F2)
   Do
      If BTest < BUFSIZE Then
         Chunk = BTest
      Else
         Chunk = BUFSIZE
      End If
      Buf = String(Chunk, " ")
      Get F1, , Buf
      Put F2, , Buf
      BTest = FSize - LOF(F2)
      ' __Call percent display here__
      'PercentDone ( 100 - Int(100 * BTest/FSize) )
   Loop Until BTest = 0
   Close F1
   Close F2
   CopyFile = FSize
   Exit Function

FileCopyError:
   MsgBox "Copy Error!"
   Close F1
   Close F2
   Exit Function
End Function