比Vba.filecopy更好的复制文件同时并显示文件复制的进度

2017-09-06 14:53:00
zstmtony
原创
417

使用Vba.filecopy 复制文件无法显示文件的复制进度,如果文件比较大的话,用户可能不知道你的Access数据库系统正在处理什么,以为死机或程序崩溃了,如果能够有一个文件复制的函数,在复制大文件的过程中能够显示复制的进度,这样交互性会更好一些

下面写的这个通用函数就是解决了这个问题:



'Src 是待复制的原文件名(含路径),Dst是目录路径或文件 
Private Function CopyFile(Src As String, Dst As String) As Single
     'Access中国的 tmtony 整理
    '复制文件并显示复制文件的进度,对大文件非常有用
     Dim BTest!, FSize!
     Dim F1%, F2%
     Dim sArray() As Byte
     Dim buff As Integer
     
     Const BUFSIZE = 1024
     
     buff = 1024
     
     F1 = FreeFile
     Open Src For Binary As F1
     F2 = FreeFile
     Open Dst For Binary As F2
     
     FSize = LOF(F1)
     BTest = FSize - LOF(F2)
     ReDim sArray(BUFSIZE) As Byte
     
     Do
     If BTest < BUFSIZE Then buff = BTest ReDim sArray(buff) As Byte End If DoEvents Get F1, , sArray Put F2, , sArray BTest = FSize - LOF(F2) If BTest < 0 Then UpdateProgress 100 Else me.窗体进度条标签.captipn= (100 - Int(100 * BTest / FSize)) '显示文件复制的进度 End If Loop Until BTest <= 0 Close F1 Close F2 CopyFile = FSize End Function
分享