Actualizar: seleccionar la ruta sin que el archivo de excel este dentro de la carpeta que contiene los archivos txt
Tengo esta macro y quiero selección la ruta donde están los archivos txt, ya que esta solo funciona cuando esta dentro de la carpeta con los demás archivos.
Sub ConvertirTxt()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
ruta = "C:\trabajo\"
ruta = l1.Path & "\"
arch = Dir(ruta & "*.txt")
Do While arch <> ""
Workbooks.OpenText Filename:=ruta & arch, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1)), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
'u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
If u = 2 And h1.[A1] = "" Then u = 1
u2 = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
c2 = h2.UsedRange.Columns(h2.UsedRange.Columns.Count).Column
h2.Range(h2.Cells(1, 1), h2.Cells(u2, c2)).Copy h1.Cells(u, "A")
arch = Dir()
l2.Close False
Loop
Application.ScreenUpdating = True
MsgBox "Archivos cargados", vbInformation, "CONVERTIR TXT"
End Sub
1 Respuesta
Listo ya las valore.
Si puedes me colaboras dejando la búsqueda por medio de una ventana para ir a buscar la carpeta donde están los txt.
H o l a:
Te anexo la macro actualizada para elegir una carpeta.
'Por. Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Selecciona una carpeta"
.AllowMultiSelect = False
.InitialFileName = l1.Path & "\"
If .Show <> -1 Then Exit Sub
ruta = .SelectedItems(1) & "\"
End With
'
arch = Dir(ruta & "*.txt")
'
Do While arch <> ""
Workbooks.OpenText Filename:=ruta & arch, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1)), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
If u = 2 And h1.[A1] = "" Then u = 1
h2.UsedRange.Copy h1.Cells(u, "A")
arch = Dir()
l2.Close False
Loop
Application.ScreenUpdating = True
MsgBox "Archivos cargados", vbInformation, "CONVERTIR TXT"
End Sub
Buenos días sera que me ayudas a que en la columna A quede el nombre del archivo txt.
¿En todas las filas?
Podrías crear la nueva pregunta.
Sal u dos
