En este ejemplo al seleccionar varios archivos los mismos se copiaran a una carpeta específica, pero antes verificará si ya existen.
Vamos crear un nuevo proyecto y colocaremos un control Commondialog y un botón.
Ahora debemos de agregar al proyecto el control Microsoft Commond Dialog. Dando un clic en el menú Proyect > Components.
También debemos de agregar la referencia Microsoft Scripting Runtime, la cual la encontraremos en el mismo men&uacte; Proyect.
Y finalmente el código y sus comentarios.
Visual Basic:
-
'Api para copiar Archivos
-
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
-
(ByVal lpExistingFileName As String, ByVal lpNewFileName _
-
As String, ByVal bFailIfExists As Long) As Long
-
-
Public Function FileExists(sFullPath As String) As Boolean
-
'Verifica si existe un archivo
-
'Debemos de Activar
-
'Microsoft Scripting Runtime en las Referencias de Visual Basic.
-
Dim oFile As New Scripting.FileSystemObject
-
FileExists = oFile.FileExists(sFullPath)
-
'Regresa Falso o Verdadero
-
End Function
-
-
-
Private Sub Command1_Click()
-
On Error GoTo TrataError
-
'Decalramos el Array dinámico de tipo String
-
Dim Archivos() As String
-
Dim i As Long, flag As String
-
-
With CommonDialog1
-
.CancelError = True ' con esto se le dice al Visual Basic que si se pulsa en Cancelar
-
.MaxFileSize = 32760
-
.FileName = ""
-
.DialogTitle = "Selección Multiple "
-
.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer
-
.ShowOpen
-
End With
-
-
'Guardamos en el array dinámico los archivos con la función Split
-
'indicandole como separador el Chr(0)
-
Archivos = Split(CommonDialog1.FileName, Chr(0))
-
-
'Recorremos el Array e imprimimos el resultado en el formulario
-
For i = 0 To UBound(Archivos)
-
Dim RutaArchivo
-
Dim pos
-
-
RutaArchivo = Archivos(i) 'Asignamos el nombre del archivo
-
Do 'Extraemos el Nombre de la ruta completa
-
pos = InStr(RutaArchivo, "\")
-
RutaArchivo = Mid(RutaArchivo, pos + 1, Len(RutaArchivo))
-
Loop Until pos = 0
-
-
'Verificamos si no existe
-
If (FileExists("C:\Temp\" & RutaArchivo)) = True Then
-
MsgBox "Archivo " & "C:\Temp\" & RutaArchivo & " ya existe"
-
Else
-
CopyFile Archivos(i), "C:\Temp\" & RutaArchivo, True
-
DoEvents
-
End If
-
Next i
-
-
'Eliminamos el array "Archivos"
-
Erase Archivos
-
Exit Sub
-
-
TrataError:
-
If Err.Number = 32755 Then
-
MsgBox "El proceso se Cancelo"
-
Err.Clear
-
Exit Sub
-
End If
-
End Sub
Clic para descargar el archivo
