Jump to content

Archived

This topic is now archived and is closed to further replies.

Jamel

Importar datos desde un archivo de texto separado con barra vertical

Recommended Posts

Buenas tardes señores mi consulta es la siguiente:

En el archivo adjunto se encuentran dos archivos de textos, el código que estoy buscando es que cuando se corra la macro, estos datos se coloquen en las hojas con el respectivo nombre.

he estado navegando buscando un código en el Internet pero no encontré ninguno que importe con "|" (Barra vertical).

Encontré este:

Sub abrir_txt()
On Error Resume Next
milibro = ActiveWorkbook.Name
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONA CARPETA", 0, "c:\").items.Item.Path
ChDir carpeta & "\"
archi = Dir("*.txt")
Do While archi <> ""
Workbooks.OpenText archi, origin:=xlWindows, startrow:=1, DataType:=xlDelimited
otro = ActiveWorkbook.Name
ActiveSheet.Copy before:=Workbooks(milibro).Sheets(1)
Workbooks(otro).Close False
archi = Dir()
Loop
End Sub

El detalle es que sea automático, gracias por la atención.

Posdata: De tiempo no entraba saludos a todos.

Ayuda.zip

Link to post
Share on other sites

Hola @Jamel

Coloca este código dentro de tu módulo y ejecutalo, te va ha borrar el formato de tu hoja, pero lo puedes poner despues

 

Option Explicit
Public sLn As String
Public sFName As String
Public iFNumber As Integer
Public lR As Long
Public lC As Long
Public vVal As Variant
Public iC As Integer
  
Public Sub ExtraerTxt()
'Max2005
    Sheets("01").Select
    Range("A1").Select
   
    sFName = "C:\01.txt" 'Cambiar a la ubicación de tu base de datos TXT
    iFNumber = FreeFile
    
    Open sFName For Input As #iFNumber
    Hoja1.Cells.Clear
    lR = 2
    
    Do
        Line Input #iFNumber, sLn
        vVal = Split(sLn, "|")
        
        With Hoja1
            lC = 1
            For iC = LBound(vVal) To UBound(vVal)
                .Cells(lR, lC) = vVal(iC)
                lC = lC + 1
            Next iC
            
        End With
        lR = lR + 1
    Loop Until EOF(iFNumber)
    
    Close #iFNumber
End Sub

Espero sea lo que necesitas

Saludos !!!

Mucha Suerte

 

Link to post
Share on other sites

Otra opción. Ejecuta la macro ImportarArchivosTXT.

Sub ImportarArchivosTXT(): On Error Resume Next
Dim Archivo, Carpeta, Navegador
Set Navegador = CreateObject("shell.application")
Carpeta = Navegador.browseforfolder(0, "SELECCIONA CARPETA", 0, "C:\").items.Item.Path
If Carpeta = Empty Then Exit Sub
ChDir Carpeta & "\"
Archivo = Dir("*.txt")
Do While Archivo <> ""
   ImportarTXT Carpeta & "\" & Archivo
   Archivo = Dir()
Loop
End Sub

'---------------------------------------------------------------
Private Sub ImportarTXT(Archivo As String): On Error Resume Next
Sheets.Add
[A1] = "COD_MOV": [B1] = "FECHA": [C1] = "TIPO"
[D1] = "NUMERO":  [E1] = "ID":    [F1] = "NOMBRE"
[G1] = "VENTA":   [H1] = "REF":   [I1] = "CAMBIO"
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Archivo, Destination:=Range("$A$2"))
   .TextFileOtherDelimiter = "|" '<-------------- DELIMITADOR
   .Refresh BackgroundQuery:=False
End With
ActiveSheet.Cells.EntireColumn.AutoFit
End Sub

 

Link to post
Share on other sites

Hola si los revisado, gracias por la atención con algunos cambios por los detalles lo hice así:

Option Explicit
Public sLn As String
Public sFName As String
Public iFNumber As Integer
Public lR As Long
Public lC As Long
Public vVal As Variant
Public iC As Integer
Dim FILA_FINAL As Integer

  
Public Sub ExtraerTxt()
'Max2005
    Sheets("01").Select
    Range("A1").Select
   
    sFName = "D:\01.txt" 'Cambiar a la ubicación de tu base de datos TXT
    iFNumber = FreeFile
    
    Open sFName For Input As #iFNumber
    Hoja1.Select
    
   Range("D2:D100").Select
   Selection.NumberFormat = "@"

   Range("G2:G100").Select
   Selection.NumberFormat = "0.00"
       
   Range("I2:I100").Select
   Selection.NumberFormat = "0.00"
   Range("A1").Select
       
      lR = 2    
    Do
        Line Input #iFNumber, sLn
        vVal = Split(sLn, "|")        
        With Hoja1
            lC = 1
            For iC = LBound(vVal) To UBound(vVal)
                .Cells(lR, lC) = vVal(iC)
                lC = lC + 1
            Next iC            
        End With
        lR = lR + 1
    Loop Until EOF(iFNumber)
    
    Close #iFNumber
    
    
FILA_FINAL = Range("A" & Cells.Rows.Count).End(xlUp).Row
Range("A2:I" & FILA_FINAL).Select
Selection.NumberFormat = "General"
Range("A1").Select
    
End Sub

Ahora el detalle es en que linea y con que código cambiaría para que la macro deje escocer la carpeta (Así como el ejemplo que me mostró Macro Antonio.

Gracias

 

Link to post
Share on other sites
Guest
This topic is now closed to further replies.

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.




×
×
  • Create New...

Important Information

Privacy Policy