Copiar, Mover y Eliminar ficheros usando el API de Windows (SHFileOperation)    

 

Según las opciones que se especifiquen, ver el listado, Windows nos pedirá confirmación o no, nos avisará si tiene que crear el directorio de destino e incluso hará una copia si el fichero de destino ya existe.

En este ejemplo sólo se manipula un fichero, para especificar varios ficheros, hay que separar cada nombre con vbvNullChar, ver el ejemplo de enviar ficheros a la papelera de reciclaje, para una función que acepta varios nombres de ficheros en el parámetro.


'------------------------------------------------------------------------------
' Ejemplo de copiar y mover ficheros usando el API de Windows       (11/May/99)
'
' ©Guillermo 'guille' Som, 1999
'------------------------------------------------------------------------------
Option Explicit

' Variables para el programa de prueba
Private sFicOri As String
Private sFicDes As String
Private iFlags As Long
' Constantes para el orden de los chkOpciones
Private Enum eOpciones
    cFOF_ALLOWUNDO
    cFOF_FILESONLY
    cFOF_MULTIDESTFILES
    cFOF_NOCONFIRMATION
    cFOF_NOCONFIRMMKDIR
    cFOF_RENAMEONCOLLISION
    cFOF_SILENT
    cFOF_SIMPLEPROGRESS
End Enum

' Variables, constantes y declaraciones para el API
Private Type SHFILEOPSTRUCT
    hWnd As Long                        ' hWnd del formulario
    wFunc As Long                       ' Función a usar: FO_COPY, etc.
    pFrom As String                     ' Fichero(s) de origen
    pTo As String                       ' Fichero(s) de destino
    fFlags As Integer                   ' Opciones
    fAnyOperationsAborted As Boolean    ' Si se ha cancelado
    hNameMappings As Long               '
    lpszProgressTitle As String         ' Sólo si se usa FOF_SIMPLEPROGRESS
End Type

' Constantes para FileOperation
Private Enum eFO
    FO_COPY = &H2                       ' Copiar
    FO_DELETE = &H3                     ' Borrar
    FO_MOVE = &H1                       ' Mover
    FO_RENAME = &H4                     ' Renombrar
    '
    FOF_MULTIDESTFILES = &H1            ' Multiples archivos de destino
    FOF_CONFIRMMOUSE = &H2              ' No está implementada
    FOF_SILENT = &H4                    ' No mostrar el progreso
    FOF_RENAMEONCOLLISION = &H8         ' Cambiar el nombre si el archivo de destino ya existe
    FOF_NOCONFIRMATION = &H10           ' No pedir confirmación
    FOF_WANTMAPPINGHANDLE = &H20        '// Fill in SHFILEOPSTRUCT.hNameMappings
                                        '// Must be freed using SHFreeNameMappings
    FOF_ALLOWUNDO = &H40                ' Permitir deshacer
    FOF_FILESONLY = &H80                ' Si se especifica *.*, hacerlo sólo con archivos
    FOF_SIMPLEPROGRESS = &H100          ' No mostrar los nombres de los archivos
    FOF_NOCONFIRMMKDIR = &H200          ' No confirmar la creación de directorios
    FOF_NOERRORUI = &H400               '// don't put up error UI
    FOF_NOCOPYSECURITYATTRIBS = &H800   '// don't copy NT file Security Attributes
End Enum

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

Private Sub cmdCopiar_Click()
    ' Copiar
    Dim SHFileOp As SHFILEOPSTRUCT
    
    ' Asignar el valor de las opciones
    AsignarFlags
    
    sFicOri = txtOri & vbNullChar & vbNullChar
    sFicDes = txtDes & vbNullChar & vbNullChar
    
    With SHFileOp
        .wFunc = FO_COPY
        .fFlags = iFlags
        .hWnd = Me.hWnd
        .pFrom = sFicOri
        .pTo = sFicDes
        .lpszProgressTitle = "Copiando los ficheros especificados"
    End With
    
    Call SHFileOperation(SHFileOp)
End Sub

Private Sub cmdEliminar_Click()
    ' Eliminar
    Dim SHFileOp As SHFILEOPSTRUCT
    
    ' Asignar el valor de las opciones
    AsignarFlags
    
    sFicDes = txtDes & vbNullChar & vbNullChar
    
    With SHFileOp
        .wFunc = FO_DELETE
        .fFlags = iFlags
        .hWnd = Me.hWnd
        .pFrom = sFicDes
        .lpszProgressTitle = "Eliminando el fichero especificado"
    End With
    
    Call SHFileOperation(SHFileOp)
End Sub

Private Sub cmdMover_Click()
    ' Mover
    Dim SHFileOp As SHFILEOPSTRUCT
    
    ' Asignar el valor de las opciones
    AsignarFlags
    
    sFicOri = txtOri & vbNullChar & vbNullChar
    sFicDes = txtDes & vbNullChar & vbNullChar
    
    With SHFileOp
        .wFunc = FO_MOVE
        .fFlags = iFlags
        .hWnd = Me.hWnd
        .pFrom = sFicOri
        .pTo = sFicDes
        .lpszProgressTitle = "Moviendo los ficheros especificados"
    End With
    
    Call SHFileOperation(SHFileOp)

End Sub

Private Sub Form_Load()
    Dim i As Long
    
    sFicOri = App.Path & "\Prueba.txt"
    sFicDes = App.Path & "\Temporal\Prueba.txt"
    
    txtOri = sFicOri
    txtDes = sFicDes
    
    ' Crear el fichero de prueba.txt
    i = FreeFile
    Open sFicOri For Output As i
    Print #i, "Fichero de prueba"
    Close
End Sub

Private Sub AsignarFlags()
    ' Ajusta el valor del flag, según las opciones seleccionadas
    iFlags = 0
    If chkOpciones(cFOF_ALLOWUNDO) Then _
        iFlags = iFlags + FOF_ALLOWUNDO
    
    If chkOpciones(cFOF_FILESONLY) Then _
        iFlags = iFlags + FOF_FILESONLY
    
    If chkOpciones(cFOF_MULTIDESTFILES) Then _
        iFlags = iFlags + FOF_MULTIDESTFILES
    
    If chkOpciones(cFOF_NOCONFIRMATION) Then _
        iFlags = iFlags + FOF_NOCONFIRMATION
    
    If chkOpciones(cFOF_NOCONFIRMMKDIR) Then _
        iFlags = iFlags + FOF_NOCONFIRMMKDIR
    
    If chkOpciones(cFOF_RENAMEONCOLLISION) Then _
        iFlags = iFlags + FOF_RENAMEONCOLLISION
    
    If chkOpciones(cFOF_SILENT) Then _
        iFlags = iFlags + FOF_SILENT
    
    If chkOpciones(cFOF_SIMPLEPROGRESS) Then _
        iFlags = iFlags + FOF_SIMPLEPROGRESS
End Sub