Necesito que al ejecutar una macro de importación de txt a excel me pregunte por la ruta donde se encuentran los archivos

Buenas,

estoy intentando realizar una macro para que me importe varios archivos txt en excel y los ponga uno a continuación del otro.

He conseguido una macro a través de esta web que me realiza este proceso pero siempre y cuando estos archivos se encuentren en una ruta ya declarada y lo que yo necesito es que antes de importar los txt me pregunte la ruta y poder seleccionarlos con el explorador (multiselección).

Os pongo la ruta que he copiado de la web:

Sub Macro()
Const rutaOrigen As String = "C:\Users\TXITXITAS\Desktop\kk2\"
Const rutaDestino As String = "C:\Users\TXITXITAS\Desktop\kk2\kk\"
Dim miFichero As String
Dim Rango As Variant

'¿Existen archivos de extensión txt en la carpeta original?
miFichero = Dir(rutaOrigen & "*.txt")
Rango = "A1"
Do While miFichero <> ""
MsgBox "Vamos a importar el Fichero: " & rutaOrigen & " --- " & miFichero
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
rutaOrigen & miFichero, Destination:=Range(Rango))
.Name = miFichero
.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 = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False

End With
Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
Rango = Range("A" & Fila).Address
'Otras Opciones
'milibro = ActiveWorkbook.Name
miFichero = Dir
Loop

1 Respuesta

Respuesta
1

Te regreso la macro con la modificación para que puedas seleccionar la carpeta. Cambia en la macro en esta línea

Const rutaOrigen As String = "C:\Users\"

La carpeta inicial, también puedes poner "C:\" para iniciar desde la raíz de C.

Sub Macro()
'Mod.Por.DAM
    Const rutaOrigen As String = "C:\Users\"
    Const rutaDestino As String = "C:\Users\TXITXITAS\Desktop\kk2\kk\"
    Dim miFichero As String
    Dim Rango As Variant
    '
    Set navegador = CreateObject("shell.application")
    carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, rutaOrigen).items.Item.Path
    If carpeta = "" Then Exit Sub
    carpeta = carpeta & "\"
    ChDir carpeta
    '
    '¿Existen archivos de extensión txt en la carpeta original?
    miFichero = Dir("*.txt")
    Rango = "A1"
    Do While miFichero <> ""
        MsgBox "Vamos a importar el Fichero: " & rutaOrigen & " --- " & miFichero
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
            rutaOrigen & miFichero, Destination:=Range(Rango))
            .Name = miFichero
            .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 = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileOtherDelimiter = "|"
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
        Rango = Range("A" & Fila).Address
        'Otras Opciones
        'milibro = ActiveWorkbook.Name
        miFichero = Dir
    Loop
End Sub

Saludos.Dante Amor

No olvides valorar la respuesta.

Buenas!!!

Gracias por la respuesta pero.....ahora no me funciona la macro....

Lo que pasa es que la idea que necesito es que pueda abrir con la macro el explorador de carpetas y seleccionar dentro de una carpeta cualquiera (puede estar en c, d o un disco duro externo) los archivos que yo quiera que importe (no todos los archivos de la carpeta)

Ya corregí la macro para que seleccione todos los archivos de la carpeta que selecciones.

Sub Macro()
'Mod.Por.DAM
    Const rutaOrigen As String = "C:\Users\"
    Const rutaDestino As String = "C:\Users\TXITXITAS\Desktop\kk2\kk\"
    Dim miFichero As String
    Dim Rango As Variant
    '
    Set navegador = CreateObject("shell.application")
    carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, rutaOrigen).items.Item.Path
    If carpeta = "" Then Exit Sub
    carpeta = carpeta & "\"
    ChDir carpeta
    '
    '¿Existen archivos de extensión txt en la carpeta original?
    miFichero = Dir("*.txt")
    Rango = "A1"
    Do While miFichero <> ""
        MsgBox "Vamos a importar el Fichero: " & rutaOrigen & " --- " & miFichero
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
            carpeta & miFichero, Destination:=Range(Rango))
            .Name = miFichero
            .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 = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileOtherDelimiter = "|"
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
        Rango = Range("A" & Fila).Address
        'Otras Opciones
        'milibro = ActiveWorkbook.Name
        miFichero = Dir
    Loop
End Sub

Ahora, la siguiente macro es para seleccionar varios archivos. Para seleccionar varios debes mantener la tecla Control presionada y dar click con el mouse a cada archivo.

Sub archivos()
'Mod.Por.DAM
    Dim Rango As Variant
    '
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione uno o varios archivos"
        .Filters.Clear
        .Filters.Add "archivos txt", "*.txt"
        .FilterIndex = 1
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path
        If .Show Then
            Rango = "A1"
            For Each ar In .SelectedItems
                With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & _
                    ar, Destination:=Range(Rango))
                    .Name = ar
                    .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 = True
                    .TextFileTabDelimiter = False
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = True
                    .TextFileOtherDelimiter = "|"
                    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
                Fila = Range("A" & Rows.Count).End(xlUp).Row + 1
                Rango = Range("A" & Fila).Address
            Next
        End If
    End With
End Sub

¡Gracias! Perfecto!!!!!!

Es justo lo que necesitaba!!!

Soy nueva en esto así que no se exactamente si he valorado correctamente tu respuesta.....pero desde luego un 10!!!!!

Gracias de nuevo!!!!

Al final de mi respuesta dice: “Es una buena respuesta” y puedes seleccionar una de 3 opciones:

- Excelente

- Si

- No

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Importar varios archivos de texto en una sola hoja de Excel

Estaba buscando una macro para importar varios archivos de texto en una sola hoja de excel y encontré esta macro: ------------------------------------------------------------------------------------------------------------------ Sub...
1 respuesta

Como puedo importar datos de un archivo .txt a una hoja de Excel mediante un macro

Mi problema es que tengo unos datos en un archivo .txt de esta forma: 11 12 13 14 Necesito mediante un macro leer cada valor y guardarlo en un arreglo para asi imprimirlo en mi hoja de excel.
1 respuesta

Detectar Celdas Seleccionadas

Necesito saber a través de una macro que celdas están seleccionadas por el usuario, ya que de un archivo txt bajare la información a dichas celdas seleccionadas, ¿Cómo detecto las celdas seleccionadas?
2 respuestas

Importar txt excel con ruta y nombre

He creado una mini-macro que importa el texto de un txt a excel dividiendo por columnas ya que es así como me interesa hacerlo, pero me surge un problema. Únicamente funciona para la carpeta donde se ha creado y para el nombre del archivo de txt. La...
2 respuestas

Macro para importar txt en excel

Necesito una ayudita para crear una macro para importar un txt a excel, la quisiera especificarle la ruta para que tome el archivo sin preguntarme.
1 respuesta

En macros mostrar mensaje de error

Estoy aprendiendo macros y cree una rutina por grabación quisiera colocarle un mensaje de error cuando no se cumpla una de las condiciones que se establecieron por ejemplo "no olvide que la ext debe ser .PV1"
1 respuesta

Macro guardar en PDF y mandar el archivo el PDF por correo

Quería saber si alguien me podía ayudar a crear o modificar un macro que guarde un archivo en PDF con nombre en base a una celda que es un formato concatenar de una celda que también es consecutivo, para después este archivo en PDF mandarlo por...
1 respuesta

Listar rutas de carpetas dentro de otra carpeta

Soy muy nuevo en esto, he empezado hace poco con las macros y es algo que me parece interesante, de momento voy investigando con las que me bajo, las voy modificando a mis necesidades. Ahora necesito para el trabajo lo siguiente: Supongamos que tengo...
11 respuestas

Macro que Crea PDF y Envía El PDF por Outlook

De la manera más amable solicito ayuda, ya he creado una macro que me permite hacer un archivo en PDF, lo que requiero es que el archivo que fue creado sea enviado vía por medio de Outlook. Adjunto código de la macro para crear el PDF. Sub...
1 respuesta