各位高手看过来了，如何在文件拷贝的过程中加入进度条？

Question

循环过程中每拷贝一个字节就加入一条DOEVENTS函数

Answer 1

每拷一个byte加一个doevents，还要改进度条，是不是效率太低了？改成1kbytes怎样。

Answer 2

随情况而定了，先取得文件的长度，如果超过一定的长度，则改成1kbytes。否则用1byte
否则的话，小文件就看不到进度条的效果了。这是细节问题。

Answer 3

其实很简单，就在更改进度条控件的值语句后，加上 DoEvents 语句即可。不用给我300分，280就行。

Answer 4

gz
我也遇到此问题Private Sub cmdNext_Click()
    On Error Resume Next
    If Dir(Trim(txtPath.Text), vbDirectory) = "" Then
        MsgBox "请检查路径是否正确，或者按浏览按钮。", vbOKOnly + 32, "路径错误..."
        Exit Sub
    End If
    On Error GoTo 0
    Dim TempFile As String, ObjectFile As String
    TempFile = App.Path & "\data\data.mdb"    If Dir(TempFile) = "" Then
        MsgBox "数据文件遭破坏，不能备份。", vbOKOnly + 16, "警告..."
        txtPath.Enabled = False
        cmdNext.Enabled = False
        cmdBrowser.Enabled = False
        Exit Sub
    End If    ObjectFile = Trim(txtPath.Text)
    If Right(ObjectFile, 1) <> "\" Then
        ObjectFile = ObjectFile + "\"
    End If
    ObjectFile = ObjectFile + "data.mdb"
    
    If Dir(ObjectFile) <> "" Then
        If UCase(ObjectFile) = UCase(TempFile) Then
            MsgBox "备份目录不能与源目录相同！", vbOKOnly + 32, "注意..."
            Exit Sub
        End If
        Dim YN As Integer
        YN = MsgBox("该目录下已经存在备份文件，要覆盖吗？(Y/N)", vbYesNo + 16, "警告...")
        If YN = 6 Then
            Kill ObjectFile
        Else
            Exit Sub
        End If
    End If
    
    Me.MousePointer = 11
    txtPath.Enabled = False
    cmdNext.Enabled = False
    cmdBrowser.Enabled = False
    cmdEnd.Default = True
    
    ProcessB = True
    ProcessP.Visible = True
    ProcessP.Refresh
    
    'Starting Copy file
    On Error GoTo ProtectON
    FileCopy TempFile, ObjectFile
    '操作代码
    FileS.Caption = FileLen(TempFile) / 1024
    FileS.Caption = FileS.Caption + "KB"
    FileN.Caption = TempFile
    FileM.Caption = FileDateTime(TempFile)
    Dim FS As Long, X As Long
    FS = FileLen(TempFile)
    Bar.Max = FS
    Bar.Min = 1
    
    For X = 1 To FS
        Bar.Value = X
        DoEvents
    Next X
    
    ProcessB = False
    cmdEnd.Enabled = True
    Me.MousePointer = 0
    DisplayStatus.Caption = "恭喜,备份工作已经顺利完成。"
    Exit SubProtectON:
    MsgBox "磁盘写保护或者写到只读的磁盘。", vbOKOnly + vbCritical, "写保护..."
    
    FileS.Caption = "未知"
    FileN.Caption = "未知"
    FileM.Caption = "未知"
    
    ProcessB = False
    cmdEnd.Enabled = True
    cmdEnd.Caption = "关闭"
    Me.MousePointer = 0
    DisplayStatus.Caption = "出现错误,错误备份工作没有完成!"End Sub

Answer 5

Private Const FO_COPY = &H1
Private Const FO_MOVE = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H3
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SILENT = &H4
Private Const FOF_NOERRORUI = &H400
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Long
        hNameMappings As Long
        lpszProgressTitle As String '  only used if FOF_SIMPLEPROGRESS
End TypePublic Function CopyFile(ByVal sFrom As String,ByVal sTo As String) As Boolean
    Dim udtPath As SHFILEOPSTRUCT
    udtPath.hwnd = 0
    udtPath.wFunc = FO_COPY
    udtPath.pFrom = sFrom
    udtPath.pTo = sTo
    udtPath.fFlags = FOF_NOCONFIRMATION 'Or FOF_SILENT Or FOF_NOERRORUI
    CopyFile= Not CBool(SHFileOperation(udtPath))
End Function'调用CopyFile将出现标准的Windows文件拷贝窗口，FOF_SILENT表示执行拷贝而不显示窗口，FOF_NOERRORUI表示不弹出错误对话框