Macro: Abrir varios Archivos TXT cantidad Variable
¿Cómo puedo abrir varios archivos TXT que se encuentran en una ruta especifica?, lo que pasa es que a veces es 1, 2, 3 o 4, y el nombre es diferente para cada uno. Solo quisiera que buscara cada archivo y si no lo encuentra que salte al siguiente sin que genere error. Gracias
Dim Archivo As String
Workbooks.OpenText Filename:="D:\Archivos RM\EXTP1", Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(0, 2), _
TrailingMinusNumbers:=True
If Not Dir(Archivo) = "" Then
Workbooks.Open Filename:=Archivo
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("MCR RDM NUEVA 2016.xlsm").Activate
Sheets("EXTRACTO POS").Select
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Windows("EXTP1").Activate
Workbooks("EXTP1").Close SaveChanges:=False
End If
1 respuesta
Te anexo la macro para abrir los archivos de la ruta
Cambia en la macro ruta = "D:\Archivos RM\" por el nombre de la ruta donde tengas los archivos txt
Sub abrirtxt()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("EXTRACTO POS")
ruta = "D:\Archivos RM\"
'ruta = l1.Path & "\"
archi = Dir(ruta & "*.txt")
Do While archi <> ""
Workbooks.OpenText Filename:=ruta & archi, Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(0, 2), _
TrailingMinusNumbers:=True
If Err.Number = 0 Then
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Range("A1:A" & u2).Copy h1.Range("A" & u1)
l2.Close False
End If
Err.Number = 0
archi = Dir()
Loop
End Sub' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
