Option Compare Database
Option Explicit

Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4

Public Const FOF_MULTIDESTFILES = &H1
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_CONFIRMMOUSE = &H2
Public Const FOF_FILESONLY = &H80 ' on *.*, Do only files
Public Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.
Public Const FOF_NOCONFIRMMKDIR = &H200 ' don't confirm making any needed dirs
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_SILENT = &H4 ' don't create progress/report
Public Const FOF_SIMPLEPROGRESS = &H100 ' means don't show names of files
Public Const FOF_WANTMAPPINGHANDLE = &H20 ' Fill in SHFILEOPSTRUCT.hNameMappings

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 ' only used If FOF_SIMPLEPROGRESS
End Type

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Declare Sub SHFreeNameMappings Lib "shell32.dll" (ByVal hNameMappings As Long)
'© Serg Gribanow E-mail prbasic@lcpi.lipetsk.ru
'am modify a little :)
Public Function dlgCopyFile(ByVal hWnd As Long, ByVal PathFrom As String, _
ByVal PathTo As String, ByVal wFunc As Integer, Optional iFlags As Integer) As Boolean
Dim acSHellFileStruct As SHFILEOPSTRUCT
Dim A As Integer

With acSHellFileStruct
.hWnd = hWnd
.wFunc = wFunc
.pFrom = PathFrom '& vbNullChar & vbNullChar
.pTo = PathTo
If iFlags =  0  Then
.fFlags = (FOF_SIMPLEPROGRESS And FOF_RENAMEONCOLLISION)
Else
.fFlags = iFlags
End If
'.fAnyOperationsAborted = True - для чтения была ли прервана команда копирования
'.lpszProgressTitle =  "перетаскивание файлов"  '& vbNullChar
End With

A = SHFileOperation(acSHellFileStruct)
Call SHFreeNameMappings(acSHellFileStruct.hNameMappings) ' освобождаем ресурсы

dlgCopyFile = acSHellFileStruct.fAnyOperationsAborted

End Function