Maxro para generar txt con campos separados por pipes |

[Alex_edm]

Hola:

No soy muy experto en Excel, y estoy volviéndome loco para intentanr generar un archivo .txt de una de las hojas de un libro. Lo que intento hacer es lo siguiente:

• Ejecutar la macro al pulsar le Botón de la primera página (Generar Archivo para Baan), es decir que solo con pulsar se genere el .txt.
• Generar un archivo .txt que contenga los campos de una página concreta (en mi caso BAAN), pero separados por |. Ejemplo: TH317115R01|150|1|A1120122|170119|0|0.00
• En la página de la que quiero generar el .txt tengo formulas condicionales en las celdas, pero en archivo de salida me gustaría sacar solo las que estén rellenas con valor (es decir hayan cumplido la condición)
• Guardar ese .txt en  la misma ubicación del Libro Excel.

Os adjunto el archivo con lo que he podido hacer pero no me funciona. Gracias de antemano.

Private Sub GENERAR_ARCHIVO_BAAN_Click()
    Sheets("tarjetas").Select
    LibroActual = ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\tarjetas.txt", _
    FileFormat:=xlCSV, CreateBackup:=False
    Workbooks.Open ThisWorkbook.Path & "\" & LibroActual
End Sub

Prueba_Foro.rar

[isidrod]

@Alex_edm te dejo este a ver si te funciona

https://excelsignum.com/2016/02/15/importar-archivos-txt-delimitados-por-caracteres/comment-page-1/

https://excelsignum.com/2016/06/10/exportar-archivos-txt-delimitados-por-caracteres-desde-excel/

[isidrod]

Sub Pasar_TXT()

Application.ScreenUpdating = False

Dim ruta As String
Dim Directorio As FileDialog
Dim nombre As String
Dim NombreHoja As String

NombreHoja = ActiveSheet.Name
Set Directorio = Application.FileDialog(msoFileDialogFolderPicker)
With Directorio
    .AllowMultiSelect = False
    .InitialFileName = ThisWorkbook.Path
    .Title = "Seleccione la Carpeta para Guardar el TXT"
    If .Show = 0 Then Exit Sub
    ruta = .SelectedItems(1)
End With

nombre = InputBox("Indique el nombre del archivo")

If nombre = "" Then
    MsgBox "No has indicado el nombre del archivo, el proceso terminará"
    Exit Sub
End If

Open ruta & "\" & nombre & ".txt" For Output As #1

Worksheets(NombreHoja).Activate
Range("A1").Select
Do While ActiveCell.Offset(0, 1).Value <> ""
    Ubica = ActiveCell.Address
    Do While ActiveCell.Column < 19
        If ActiveCell.Value <> "" Then
            Lista = Lista & "|" & ActiveCell.Value
        End If
    ActiveCell.Offset(0, 1).Select
    Loop
    Lista = Mid(Lista, 2, Len(Lista) - 1)
    Print #1, Lista
    Lista = ""
    Range(Ubica).Offset(1, 0).Select
Loop
Close #1
MsgBox "Se ha creado el archivo txt con nombre " & nombre

Application.ScreenUpdating = True

End Sub

y este código te dejo  espero que te funcione no tengo su link pero ahí te lo dejo

[Alex_edm]

Hola Isidrod:

Muchas gracias por tus aportación, me ha servido y de hecho consigo que me genere el archivo tal y como quiero. El tema está en que necesito que me genere el .txt al pulsar el botón Active X de la primera página, pero me da error 1004 al empezar a leer la celda A1. Alguna idea de por que podría ser?

Muchas Gracias. Un saludo.

 

 

Private Sub GENERAR_ARCHIVO_BAAN_Click()

Application.ScreenUpdating = False

Dim ruta As String
Dim Directorio As FileDialog
Dim nombre As String
Dim NombreHoja As String

NombreHoja = Worksheets(3).Name
'NombreHoja = "baan"
Set Directorio = Application.FileDialog(msoFileDialogFolderPicker)
With Directorio
    .AllowMultiSelect = False
    .InitialFileName = ThisWorkbook.Path
    .Title = "Seleccione la Carpeta para Guardar el TXT"
    If .Show = 0 Then Exit Sub
    ruta = .SelectedItems(1)
End With

nombre = InputBox("Indique el nombre del archivo")

If nombre = "" Then
    MsgBox "No has indicado el nombre del archivo, el proceso terminará"
    Exit Sub
End If

Open ruta & "\" & nombre & ".txt" For Output As #1

Worksheets(NombreHoja).Activate
Range("A1").Select (ERROR 1004)
Do While ActiveCell.Offset(0, 1).Value <> ""
    Ubica = ActiveCell.Address
    Do While ActiveCell.Column < 19
        If ActiveCell.Value <> "" Then
            Lista = Lista & "|" & ActiveCell.Value
        End If
    ActiveCell.Offset(0, 1).Select
    Loop
    Lista = Mid(Lista, 2, Len(Lista) - 1)
    Print #1, Lista
    Lista = ""
    Range(Ubica).Offset(1, 0).Select
Loop
Close #1
MsgBox "Se ha creado el archivo txt con nombre " & nombre

Application.ScreenUpdating = True

'End Sub
End Sub

 

Prueba_Foro1.rar

[Alex_edm]

He conseguido solucionarlo, dejo el código por si alguien le pudiera interesar.

Private Sub GENERAR_ARCHIVO_BAAN_Click()

Application.ScreenUpdating = False

Dim ruta As String
Dim Directorio As FileDialog
Dim nombre As String
Dim NombreHoja As String

'Seleccionar la Hoja de la que se cogen los datos para baan
NombreHoja = Worksheets(3).Name

Set Directorio = Application.FileDialog(msoFileDialogFolderPicker)
With Directorio
    .AllowMultiSelect = False
    .InitialFileName = ThisWorkbook.Path
    .Title = "Seleccione la Carpeta para Guardar el .txt"
    If .Show = 0 Then Exit Sub
    ruta = .SelectedItems(1)
End With

nombre = InputBox("Indica el nombre del archivo")

If nombre = "" Then
    MsgBox "No has indicado el nombre del archivo, el proceso terminará"
    Exit Sub
End If

Open ruta & "\" & nombre & ".txt" For Output As #1

Worksheets(NombreHoja).Activate
Worksheets(NombreHoja).Range("A1").Select

Do While ActiveCell.Offset(0, 1).Value <> ""
    Ubica = ActiveCell.Address
    Do While ActiveCell.Column < 19
        If ActiveCell.Value <> "" Then
            Lista = Lista & "|" & ActiveCell.Value
        End If
    ActiveCell.Offset(0, 1).Select
    Loop
    Lista = Mid(Lista, 2, Len(Lista) - 1)
    Print #1, Lista
    Lista = ""
    Worksheets(NombreHoja).Range(Ubica).Offset(1, 0).Select
Loop
Close #1
MsgBox "Se ha creado el archivo .txt exportable para baan con nombre " & nombre

Application.ScreenUpdating = True

End Sub

[isidrod]

que bueno que solucionaste tu tema 

caso cerrado