Como Seleccionar archivos y pegar sus nombres y rutas a través de una macro?
Para Dante
Vuelvo y hago la pregunta porque no se si se envió.
Hola Ing, por favor me podría ayudar con este caso:
El código en articulo y es estupendo y cumple con su objetivo, pero quisiera que operará adicionalmente con la opción de seleccionar los archivos deseados y no todo el contenido de la carpeta.
Buscando encontré en este enlace el código que hace parte de lo que necesito. Pero necesito la ayuda para complementar los dos código con el encontrado para obtener el resultado deseado.
https://msdn.microsoft.com/es-es/library/office/hh710200(v=office.14).aspx
“Seleccionar archivos mediante programación en Excel para Windows y Excel para Mac”
CODIGO 1
Extraer nombres de archivos de una carpeta
Sub GetFileNames()
Dim fila As Long
Dim Ruta_elegida, Nombre_archivo, Ruta_inicial
Ruta_inicial = "C:\" '<<< Donde comienzo a mirar
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Selecciona una carpeta"
.InitialFileName = Ruta_inicial
.Show
If .SelectedItems.Count <> 0 Then 'Compruebo que se ha seleccionado una carpeta
Ruta_elegida = .SelectedItems(1) & "\" 'Ruta que he elegido
Nombre_archivo = Dir(Ruta_elegida) 'primer archivo de la carpeta
Do While Nombre_archivo <> ""
Cells(7, 1).Offset(fila) = Nombre_archivo
fila = fila + 1
Nombre_archivo = Dir 'siguiente archivo
Loop
End If
End With
End Sub
EL OTRO CODIGO ENCONTRADO Y QUE SELECCIONA ARCHIVOS
Parte del código desedo pero que cumpla con el objetivo copiar
Sub Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
' Save the current directory.
SaveDriveDir = CurDir
' Set the path to the folder that you want to open.
MyPath = Application.DefaultFilePath
' You can also use a fixed path.
'MyPath = "C:\Users\Ron de Bruin\Test"
' Change drive/directory to MyPath.
ChDrive MyPath
ChDir MyPath
' Open GetOpenFilename with the file filters.
Fname = Application.GetOpenFilename( _
FileFilter:="Files (*.*), *.*", _
Title:="Select a file or files", _
MultiSelect:=True)
1 respuesta
¿El código lo quieres para excel de windows o para excel de mac? Bueno, solamente podría ayudarte con el de windows.
Lo que entiendo es:
- Quieres seleccionar una carpeta,
- Que te muestre los archivos de esa carpeta
- Seleccionar uno o varios archivos
- ¿Y luego qué quieres hacer con los archivos seleccionados?
- ¿Poner la ruta en una columna y el nombre del archivo en otra columna?
Si todo lo anterior es correcto, entonces utiliza la siguiente macro.
En la hoja1 en la columna A te pone la ruta, en la columna B te pone el nombre del archivo.
Puedes filtrar por archivos de excel o por todos los archivos.
Para seleccionar varios archivos utiliza la tecla Control o la tecla Shift y el mouse.
Sub Seleccionar_Archivos()
'---
' Por.Dante Amor
'---
Set h1 = Sheets("Hoja1")
h1.Rows("2:" & Rows.Count).ClearContents
fila = 2
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "Todos los archivos", "*.*"
.Filters.Add "Archivos de excel", "*.xls*"
.FilterIndex = 2
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
diag = InStrRev(.SelectedItems.Item(1), "\")
ruta = Left(.SelectedItems.Item(1), diag)
For Each ar In .SelectedItems
nomb = Mid(ar, diag + 1)
h1.Cells(fila, "A") = ruta
h1.Cells(fila, "B") = Mid(ar, diag + 1)
fila = fila + 1
Next
End If
End With
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
¡Gracias!
Excelente, si la macro es para que funcione con windows. Un último detalle al copiar los archivos seleccionados se puede unir la ruta+el nombre del archivo en una sola celda?.
De antemano eres todo un experto. Gracias y mil gracias por tu colaboración.
Buen día Ing Dante Amor, estuve probando la macro y quisiera que fuera mejorada en estos dos aspectos:
1. Que se pueda usar en cualquier hoja de un libro de excel.
2. Que no limpie el contenido de la hoja , solamente las celdas donde coloca la información
3. Que pueda unir en una celda la ruta + el nombre del archivo
Gracias
Va:
Sub Seleccionar_Archivos()
'---
' Por.Dante Amor
'---
Set h1 = ActiveSheet 'Sheets("Hoja1")
'h1.Rows("2:" & Rows.Count).ClearContents
fila = 2
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "Todos los archivos", "*.*"
.Filters.Add "Archivos de excel", "*.xls*"
.FilterIndex = 2
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
diag = InStrRev(.SelectedItems.Item(1), "\")
ruta = Left(.SelectedItems.Item(1), diag)
For Each ar In .SelectedItems
nomb = Mid(ar, diag + 1)
h1.Cells(fila, "A") = ar 'ruta
'h1.Cells(fila, "B") = Mid(ar, diag + 1)
fila = fila + 1
Next
End If
End With
MsgBox "Fin"
End Subsal u dos
