Sa progressbarom iz Windows Explorera
Code:
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Declare Function shFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FOF_ALLOWUNDO = &H40
'No user interface will be displayed if an error occurs.
Private Const FOF_NOERRORUI = &H400
Private Const FOF_SILENT = &H4 ' don't create progress/report
Private Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.
Private Const FOF_FILESONLY As Long = &H80
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_NOCONFIRMMKDIR As Long = &H200
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
' sFrom can be multiple files seperated by vbNullChar
' bFilesOnly: If true only files will be copied or moved if sFrom has wildcards.
' e.g. C:\*.*
Function FileOperation(ByVal sFrom As String, ByVal sTo As String, _
Optional bMoveFiles As Boolean = False, _
Optional bShowProgress As Boolean = False, _
Optional ByVal bPromptUser As Boolean = False, _
Optional ByVal bFilesOnly As Boolean, _
Optional ByRef bOperationAborted As Boolean) As Long
Dim shFileOpt As SHFILEOPSTRUCT
With shFileOpt
.hwnd = Me.hwnd
If bMoveFiles Then
.wFunc = FO_MOVE
Else
.wFunc = FO_COPY
End If
.fFlags = FOF_ALLOWUNDO
If bShowProgress Then .fFlags = .fFlags Or FOF_SIMPLEPROGRESS
If Not bPromptUser Then .fFlags = .fFlags Or FOF_NOCONFIRMATION Or FOF_NOERRORUI
If bFilesOnly Then .fFlags = .fFlags Or FOF_FILESONLY
.pFrom = sFrom & vbNullChar & vbNullChar
.pTo = sTo & vbNullChar & vbNullChar
End With
FileOperation = shFileOperation(shFileOpt) ' Returns zero if no error
bOperationAborted = shFileOpt.fAnyOperationsAborted
End Function