Snippet Library

Option Explicit

Public Type SHFILEOPSTRUCT
    hWnd As Long 'an hWnd of a form
    wFunc As Long 'one of the File Operation Consts
    pFrom As String 'Source path and file
    pTo As String 'Destination path and file
    fFlags As Long 'Combination of the FOF_ flags
    fAnyOperationsAborted As Long 'Flag indicating that operations did not
    complete
    hNameMappings As Long 'Pointer to name maps for files that were
    renamed To avoid conflicts
    lpszProgressTitle As String 'Caption to appear in title bar of
    progress dialog
End Type

'File Operation constants
Public Enum FO_OPS
    FO_MOVE = &H1
    FO_COPY = &H2
    FO_DELETE = &H3
    FO_RENAME = &H4
End Enum

'File Operation Flag Constants
Public Enum FO_FLAGS
    FOF_MULTIDESTFILES = &H1 'The pTo member specifies multiple destination
    files (one For Each source file) rather than one directory where all source
    files are To be deposited.
    FOF_CONFIRMMOUSE = &H2 'Not currently implemented.
    FOF_SILENT = &H4 'Does not display a progress dialog box.
    FOF_RENAMEONCOLLISION = &H8 'Give the file being operated on a new name
    In a move, copy, Or rename operation If a file With the target Name already
    exists.
    FOF_NOCONFIRMATION = &H10 'Respond with Yes to All for any dialog box
    that Is displayed.
    FOF_WANTMAPPINGHANDLE = &H20 'If FOF_RENAMEONCOLLISION is specified,
    the hNameMappings member will be filled In If any files were renamed.
    FOF_CREATEPROGRESSDLG = &H0 '
    FOF_ALLOWUNDO = &H40 'Preserve Undo information, if possible.
    FOF_FILESONLY = &H80 'Perform the operation on files only if a wildcard
    file Name (*.*) Is specified.
    FOF_SIMPLEPROGRESS = &H100 'Displays a progress dialog box but does not
    show the file names.
    FOF_NOCONFIRMMKDIR = &H200 'Does not confirm the creation of a new
    directory If the operation requires one To be created.
    FOF_NOERRORUI = &H400 'No user interface will be displayed if an error
    occurs.
End Enum

Public Declare Function SHFileOperation Lib "shell32.dll" Alias
"SHFileOperationA" _
        (lpFileOp As SHFILEOPSTRUCT) As Long

Public Sub Copy(Source As String, Destination As String, _
            Optional Options As FO_FLAGS = FOF_CREATEPROGRESSDLG Or
    FOF_NOCONFIRMMKDIR)
'Remarks: - Copies files from a supplied source to a supplied
    destination
' and creates any needed directory structure if it
    does Not exist
'Author: - Craig Hunt, AISA Logic, Inc.
'Input: - Source - a null character delimited, 2 null
    character terminated
' string of source files to copy.
' (eg "c:my documentsfile.xls & chr(0) & c:my
    documentsanother.xls _
' & chr(0) & chr(0))
' Destination - a null character delimited, 2 null
            character terminated
' string of destination directories to which to copy
    Source
' Options - one or more of the FO_FLAGS enum constants
'Returns: - Nothing
    Dim lRet As Long
    Dim SHFileOp As SHFILEOPSTRUCT

    On Error GoTo Copy_Err

'ensure source and destination strings have valid terminators
    While Not Right(Source, 2) <> vbNullChar & vbNullChar
        Source = Source & vbNullChar
    Wend

    While Not Right(Destination, 2) <> vbNullChar & vbNullChar
        Destination = Destination & vbNullChar
    Wend

    With SHFileOp
        .wFunc = FO_COPY
        .pFrom = Source
        .pTo = Destination
        .fFlags = Options
    End With

    lRet = SHFileOperation(SHFileOp)


Copy_Exit:
    Exit Sub

Copy_Err:
    MsgBox Error, vbCritical
    Resume Copy_Exit

End Sub


'You could modify this code To accommodate move And 'delete by using the
'FO_OPS Enum For the wFunc Property If the SHFileOp 'structure.;