Just paste this source code into a module called basShell and include it in your project.
'----------------------------------------------------------------------
'
' Module Name: basShell
' Written By: C&D Programming Corp.
' Create Date: 10/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
'==========================================================
' Constants for the wFunc field in the SHFILEOPSTRUCT
'==========================================================
' Copies the files specified in the pFrom member to the
' location specified in the pTo member.
Public Const FO_COPY As Long = &H2
' Moves the files specified in pFrom to the location
' specified in pTo.
Public Const FO_MOVE As Long = &H1
' Deletes the files specified in pFrom. (pTo is ignored.)
Public Const FO_DELETE As Long = &H3
' Renames the files specified in pFrom.
Public Const FO_RENAME As Long = &H4
'==========================================================
' Constants for the fFlags field in the SHFILEOPSTRUCT
'==========================================================
' The pTo member specifies multiple destination
' files (one for each source file) rather than one
' directory where all source files are to be deposited.
Public Const FOF_MULTIDESTFILES As Long = &H1
' Prevent display of a progress dialog box for slow operations
Public Const FOF_SILENT As Long = &H4
' Create new numbered files (Copy #1 of...) if copied
' or moved files conflict with existing files
Public Const FOF_RENAMEONCOLLISION As Long = &H8
' Overwrite or delete files without confirmation
Public Const FOF_NOCONFIRMATION As Long = &H10
' Put deleted files (except those from floppy disks) in Recycle Bin
Public Const FOF_ALLOWUNDO As Long = &H40
' Interpret a wildcard source to mean files only, not directories
Public Const FOF_FILESONLY As Long = &H80
' Simplify the progress dialog box by not showing filenames
Public Const FOF_SIMPLEPROGRESS As Long = &H100
' Create any needed destination directories without confirmation
Public Const FOF_NOCONFIRMMKDIR As Long = &H200
' Normally the SHFILEOPSTRUCT is not double-word aligned.
' Unfortunately, Visual Basic automaticaly double-word aligns
' its structures. If no steps are taken, the last 3 variables
' will not be passed correctly. This has no impact unless
' the progress title needs to be changed.
Type SHFILEOPSTRUCT
' Window handle to the dialog box to display information
' about the status of the file operation.
hwnd As Long
' the operation to perform, as defined by one of the
' following values: FO_COPY, FO_MOVE, FO_DELETE, FO_RENAME
wFunc As Long
' Address of a buffer to specify one or more source file
' names. Multiple names must be null-separated. The list
' of names must be double null-terminated.
pFrom As String
' Address of a buffer to contain the name of the
' destination file or directory. The buffer can contain
' multiple destination file names if the fFlags member
' specifies FOF_MULTIDESTFILES. Multiple names must
' be null-separated. The list of names must be
' double null-terminated.
pTo As String
' Flags that control the file operation. See above constants
' for details.
fFlags As Long
' Value that receives TRUE if the user aborted any file
' operations before they were completed, or FALSE otherwise.
fAnyOperationsAborted As Long
hNameMappings As Long
' Address of a string to use as the title of a progress
' dialog box. This member is used only if fFlags includes
' the FOF_SIMPLEPROGRESS flag.
lpszProgressTitle As String
End Type
Private Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, _
ByVal cbCopy As Long)
' Normally the lpFileOp parameter would be defined as type
' SHFILEOPSTRUCT. Since we are doing a little
' workaround for the inability of Visual Basic to create
' a byte aligned structure we need to define it as Any.
Declare Function SHFileOperation Lib "Shell32.dll" _
Alias "SHFileOperationA" _
(lpFileOp As Any) As Long
Public Sub CopyFiles(Window As Form, vSourceFiles As Variant, vDestFiles As Variant, _
Optional sTitle As String = "", Optional bIncludeSubDirs As Boolean = False)
Dim lResult As Long
Dim typFileOperation As SHFILEOPSTRUCT
Dim sSource As String
Dim sDest As String
With typFileOperation
.hwnd = Window.hwnd
.wFunc = FO_COPY
' The files to copy separated by a vbNullChar and terminated by
' an additional vbNullChar
If TypeName(vSourceFiles) = "String()" Then
GenericArrayToString sSource, vSourceFiles, vbNullChar
sSource = sSource & vbNullChar
Else
sSource = vSourceFiles & vbNullChar
End If
.pFrom = sSource & vbNullChar
'The directory or filename(s) to copy into
If TypeName(vDestFiles) = "String()" Then
GenericArrayToString sDest, vDestFiles, vbNullChar
sDest = sDest & vbNullChar
.fFlags = FOF_MULTIDESTFILES ' since we have multiple dest
Else
sDest = vDestFiles & vbNullChar
End If
.pTo = sDest & vbNullChar
.fFlags = .fFlags Or FOF_NOCONFIRMMKDIR
If Not bIncludeSubDirs Then
.fFlags = FOF_FILESONLY
End If
If sTitle <> "" Then
.fFlags = .fFlags Or FOF_SIMPLEPROGRESS
.lpszProgressTitle = sTitle & vbNullChar & vbNullChar
End If
End With
lResult = FixUpAndCallSHFileOperation(typFileOperation)
If lResult <> 0 Then ' Operation failed
If lResult = 117 Then ' cancelled operation
Err.Raise lResult, "CopyFiles", "Operation Cancelled."
Else
Err.Raise Err.LastDllError, "CopyFiles", "Error occurred while copying files."
End If
Else
If typFileOperation.fAnyOperationsAborted <> 0 Then
Err.Raise 5, "CopyFiles", "Error occurred while copying files."
End If
End If
End Sub
'
' This routine is needed to enable Visual Basic to pass a byte aligned
' structure to the operating system.
'
Private Function FixUpAndCallSHFileOperation(fileop As SHFILEOPSTRUCT) As Long
Dim lResult As Long
Dim lFileOperationLength As Long
Dim foBuffer() As Byte
lFileOperationLength = LenB(fileop) ' calc the length of the structure
ReDim foBuffer(1 To lFileOperationLength)
' Now we need to copy the structure into a byte array
Call CopyMemory(foBuffer(1), fileop, lFileOperationLength)
' Next we move the last 12 bytes by 2 to byte align the data
Call CopyMemory(foBuffer(19), foBuffer(21), 12)
' call the system file operation api with the byte-aligned data
FixUpAndCallSHFileOperation = SHFileOperation(foBuffer(1))
End Function