带Windows进度条的复制函数

时　间:2019-03-07 10:34:29
作　者:易勋   ID：35404  城市：上海
摘　要:通过APICopyFile这个函数，复制文件或者文件夹，可以显示Windows的执行进度条。
正　文:

函数：

#If VBA7 Then
    Private Type API_SHFILEOPSTRUCT
        hwnd                        As LongPtr
        Func                        As LongPtr
        From                        As String
        To                          As String
        Flags                       As Integer
        AnyOperationsAborted        As Long
        NameMappings                As Long
        ProgressTitle               As String
    End Type
    Private Declare PtrSafe Function ApiSHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As API_SHFILEOPSTRUCT) As Long
#Else
    Private Type API_SHFILEOPSTRUCT
        hwnd                        As Long
        Func                        As Long
        From                        As String
        To                          As String
        Flags                       As Integer
        AnyOperationsAborted        As Long
        NameMappings                As Long
        ProgressTitle               As String
    End Type
    Private Declare Function ApiSHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As API_SHFILEOPSTRUCT) As Long
#End If

Public Function APICopyFile( _
        Pathname As String, _
        Optional Destination As String _
    ) As Boolean
    On Error Resume Next

    Dim typPath As API_SHFILEOPSTRUCT

    Const FOF_NOCONFIRMATION = &H10
    Const FOF_SILENT = &H4
    Const FOF_NOERRORUI = &H400

    typPath.hwnd = 0
    typPath.Func = 2

    If Right(Pathname, 1) <> "\" Then
        typPath.From = Pathname & "\*"
    Else
        typPath.From = Pathname & "*"
    End If

    If Right(Destination, 1) <> "\" Then
        typPath.To = Destination & "\"
    End If

    typPath.To = Destination

    APICopyFile = Not CBool(ApiSHFileOperation(typPath))
End Function

调用：

APICopyFile 当前路径, 目标路径