¿Cómo importar datos desde archivos seleccionados de la ventana del explorador?
Para Dante Amor
Quisiera que me ayudes a programar un botón de manera que al presionarlo me permita importar los datos de los archivos que seleccione de una ventana del explorador (tengo entendido que la función GetOpenFile podría servir para este fin). Si bien mi libro de excel va a estar contenido en esa misma carpeta, dentro de ella hay otros archivos de los cuales no todos son de interés por eso es que seria conveniente poder buscar esos archivos en el explorador.
De este modo, los datos del primer archivo que seleccione se importaran a la Hoja 1, los del segundo archivo a la Hoja 2 y así sucesivamente.
1 respuesta
H o l a:
Te anexo la macro, cuando te aparezca la ventana del explores puedes seleccionar varios archivos, presionando la tecla Ctrl y presionando botón izquierdo del mouse sobre el archivo.
Private Sub ImportarDatos_Click()
'Por.Dante Amor
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path & "\"
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivos .txt"
.Filters.Clear
.Filters.Add "Todos", "*.*"
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path & "\"
If .Show Then
For Each arch In .SelectedItems
Sheets.Add after:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & arch, Destination:=Range("$A$1"))
.Name = "archivo1_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next
End If
End With
Application.ScreenUpdating = True
MsgBox "Importación terminada"
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
