'---------------------------
'Copy any file (include open files)
'--------------------------------
Private Declare Function SHFileOperation Lib 'shell32.dll' _
Alias 'SHFileOperationA' (lpFileOp As SHFILEOPSTRUCT) As Long

Private Type SHFILEOPSTRUCT
hwnd As Long ' Window owner of any dialogs
wFunc As Long ' Copy, move, rename, or delete code
pFrom As String ' Source file
pTo As String ' Destination file or directory
fFlags As Integer ' Options to control the operations
fAnyOperationsAbortedLo As Integer ' Indicates partial failure
fAnyOperationsAbortedHi As Integer
hNameMappingsLo As Long ' Array indicating each success
hNameMappingsHi As Long
lpszProgressTitleLo As Long ' Title for progress dialog
lpszProgressTitleHi As Long
End Type



' Better version of FileCopy (CopyAnyFile) and matching MoveAnyFile,
' DeleteAnyFile, and RenameAnyFile
Function CopyAnyFile(sSrc As String, sDst As String, _
Optional ByVal fConfirmMsgShow As Boolean = True, Optional ByVal fProgressShow As Boolean = True, _
Optional Owner As Long) As Boolean
If True Then 'в NT не будет работать!!
Dim fo As SHFILEOPSTRUCT, f As Long
fo.wFunc = 2 'FO_COPY
Debug.Print TypeName(fo.wFunc)
fo.pFrom = sSrc
fo.pTo = sDst
fo.fFlags = SetOpFlagsForCopyAny(fConfirmMsgShow, fProgressShow)
fo.hwnd = Owner
' Mask out invalid flags
fo.fFlags = fo.fFlags And 989 'FOF_COPYFLAGS
f = SHFileOperation(fo)
CopyAnyFile = (f = 0)
Else ' For Windows NT 3.51
On Error Resume Next
' FileCopy expects full name of destination file
FileCopy sSrc, sDst
If Err Then
MsgBox 'Path error.', vbCritical, 'Error'
End If
CopyAnyFile = (Err = 0)
End If
End Function

Private Function SetOpFlagsForCopyAny(Optional ByVal fConfirmMsgShow As Boolean = True, Optional ByVal fProgressShow As Boolean = True) As Long
Dim lFlags As Long
lFlags = 0
If Not fConfirmMsgShow Then lFlags = lFlags Or 16 'FOF_NOCONFIRMATION
If fProgressShow Then lFlags = lFlags Or 256 'FOF_SIMPLEPROGRESS
SetOpFlagsForCopyAny = lFlags
End Function