Exportar datos de un listBox a un archivo .txt

Benito Bartolomé · el 26 de enero

Hola y buenos días a todos;

He empezado a crear una macro que me permite crear un archivo .txt pero no sé como continuar.

Quiero conseguir que los datos almacenados o filtrados inclusive los que vaya seleccionando con el ratón en el listbox del frm_Cobros los pueda capturar y poder exportarlos al archivo .txt generado.

Adjunto macro y video:

https://youtu.be/bVO7f-JZuSg

Saludos.

ExportarTxt.zip

Benito Bartolomé · el 26 de enero

He conseguido algo con este código pero me faltaría la segunda opción:

-Que pueda enviar los que seleccione con el ratón.

Adjunto código a ver si esta medianamente bien:

Private Sub btn_Txt_Click(): On Error Resume Next
Dim ruta As String, I As Integer, existe As Boolean, coleccion_archivos As New Collection, archivo As String
    ruta = ActiveWorkbook.path
    archivo = Dir(ruta & "\*.*")
    Do Until archivo = ""
    coleccion_archivos.Add archivo
    archivo = Dir()
    Loop
    
    For I = coleccion_archivos.Count To 1 Step -1
        If coleccion_archivos(I) = "tb_Cobros.txt" Then
            existe = True
        End If
    Next I
    
        If existe = True Then
    Dim z As Integer
        z = MsgBox("Ya existe el archivo de texto.¿Deseas eliminardo?", vbYesNo)
        If z = vbYes Then
            Kill ActiveWorkbook.path & "\tb_Cobros.txt"
            existe = False
        Else
        
        Open ActiveWorkbook.path & "\tb_Cobros.txt" For Append As #1
        End If
        
   End If
   
   If existe = False Then
   
        Open ActiveWorkbook.path & "\tb_Cobros.txt" For Output As #1
            MsgBox "El archivo txt fue creado"
    End If
    Dim Sep As String
    Dim x
    Sep = ";"
    Print #1, "Fecha: " & Date
    
    For x = 0 To frm_Cobros.ListBox1.ListCount - 1
        TextBox0 = ListBox1.List(x, 0)
        TextBox50 = ListBox1.List(x, 1)
        TextBox51 = ListBox1.List(x, 2)
        TextBox4 = Format(ListBox1.List(x, 3), "dd/mm/yyyy")
        TextBox5 = ListBox1.List(x, 4)
        TextBox10 = ListBox1.List(x, 5)
        TextBox6 = ListBox1.List(x, 6)
        TextBox11 = ListBox1.List(x, 7)
        TextBox7 = ListBox1.List(x, 8)
        TextBox8 = ListBox1.List(x, 9)
        TextBox12 = ListBox1.List(x, 10)
    
    Print #1, TextBox0 & Sep & TextBox50 & Sep & TextBox51 & Sep & TextBox4 & Sep & TextBox5 & Sep & TextBox10 & Sep & TextBox6 & Sep & TextBox11 & Sep & TextBox7 & Sep & TextBox8 & Sep & TextBox12
    Next x
    Print #1, "-"
    
    Close #1
End Sub

Benito Bartolomé · el 26 de enero

Buenas tardes;

-He conseguido algo con este código, imagino que se podrá mejorar .

-Si a alguno se le ocurre algo mejor que me lo diga.

Saludos.

Private Sub btn_Txt_Click(): On Error Resume Next
Dim ruta As String, i As Integer, existe As Boolean, coleccion_archivos As New Collection, archivo As String
Dim Sep As String, x As Integer, z As Integer, Cuenta As Integer

    ruta = ActiveWorkbook.path
    archivo = Dir(ruta & "\*.*")
    Do Until archivo = ""
    coleccion_archivos.Add archivo
    archivo = Dir()
    Loop
    
    For i = coleccion_archivos.Count To 1 Step -1
        If coleccion_archivos(i) = "tb_Cobros.txt" Then
            existe = True
        End If
    Next i
    
If existe = True Then
z = MsgBox("Ya existe el archivo de texto.¿Deseas eliminardo?", vbYesNo)
    If z = vbYes Then
        Kill ActiveWorkbook.path & "\tb_Cobros.txt"
        existe = False
    Else
        Open ActiveWorkbook.path & "\tb_Cobros.txt" For Append As #1
    End If
        
End If
   
If existe = False Then
    Open ActiveWorkbook.path & "\tb_Cobros.txt" For Output As #1
    MsgBox "El archivo txt fue creado"
End If
    
    Cuenta = frm_Cobros.ListBox1.ListCount
    
    Sep = ";"
    Print #1, "Fecha: " & Date
    
    For x = 0 To Cuenta - 1
        If Me.ListBox1.Selected(x) = True Then
        MsgBox Me.ListBox1.List(x), vbInformation, "Registro"
        TextBox0 = ListBox1.List(x, 0)
        TextBox50 = ListBox1.List(x, 1)
        TextBox51 = ListBox1.List(x, 2)
        TextBox4 = Format(ListBox1.List(x, 3), "dd/mm/yyyy")
        TextBox5 = ListBox1.List(x, 4)
        TextBox10 = ListBox1.List(x, 5)
        TextBox6 = ListBox1.List(x, 6)
        TextBox11 = ListBox1.List(x, 7)
        TextBox7 = ListBox1.List(x, 8)
        TextBox8 = ListBox1.List(x, 9)
        TextBox12 = ListBox1.List(x, 10)
        Print #1, TextBox0 & Sep & TextBox50 & Sep & TextBox51 & Sep & TextBox4 & Sep & TextBox5 & Sep & TextBox10 & Sep & TextBox6 & Sep & TextBox11 & Sep & TextBox7 & Sep & TextBox8 & Sep & TextBox12
        End If
    Next x
    Print #1, "-"
    Close #1
End Sub

Antoni · el 26 de enero

Esto:

    If Dir(ActiveWorkbook.Path & "\tb_Cobros.txt") <> "" Then existe = True

Sustituye a esto:

    ruta = ActiveWorkbook.Path
    archivo = Dir(ruta & "\*.*")
    Do Until archivo = ""
    coleccion_archivos.Add archivo
    archivo = Dir()
    Loop
    
    For i = coleccion_archivos.Count To 1 Step -1
        If coleccion_archivos(i) = "tb_Cobros.txt" Then
            existe = True
        End If
    Next i

Benito Bartolomé · el 27 de enero

Bo día Antoni;

Me has simplificado mucho el código.?

Con el código que a continuación insertaré consigo exportar los datos del listBox tanto si selecciono un item como varios u alternos.

Sólo me queda una duda por resolver y es:

-Como hago para poder exportar todos los datos cuando no selecciono ningún item.

If Me.ListBox1.Selected(x) = True Then

Adjunto código:

Private Sub btn_Txt_Click(): On Error Resume Next
Dim ruta As String, i As Integer, existe As Boolean
Dim Sep As String, x As Integer, z As Integer, Cuenta As Integer
Dim FechaCancel

If Dir(ActiveWorkbook.Path & "\tb_Cobros.txt") <> "" Then existe = True
    
If existe = True Then
z = MsgBox("Ya existe el archivo de texto.¿Deseas eliminardo?", vbYesNo)
    If z = vbYes Then
        Kill ActiveWorkbook.Path & "\tb_Cobros.txt"
        existe = False
    Else
        Open ActiveWorkbook.Path & "\tb_Cobros.txt" For Append As #1
    End If
        
End If
   
If existe = False Then
    Open ActiveWorkbook.Path & "\tb_Cobros.txt" For Output As #1
    MsgBox "El archivo txt fue creado"
End If
    
    Cuenta = frm_Cobros.ListBox1.ListCount
    FechaCancel = Date
    Sep = ";"
    For x = 0 To Cuenta - 1
        If Me.ListBox1.Selected(x) = True Then
        MsgBox Me.ListBox1.List(x), vbInformation, "Registro"
        TextBox0 = ListBox1.List(x, 0)
        TextBox50 = ListBox1.List(x, 1)
        TextBox51 = ListBox1.List(x, 2)
        TextBox4 = Format(ListBox1.List(x, 3), "dd/mm/yyyy")
        TextBox5 = ListBox1.List(x, 4)
        TextBox10 = ListBox1.List(x, 5)
        TextBox6 = ListBox1.List(x, 6)
        TextBox11 = ListBox1.List(x, 7)
        TextBox7 = ListBox1.List(x, 8)
        TextBox8 = ListBox1.List(x, 9)
        TextBox12 = ListBox1.List(x, 10)
        Print #1, "Fecha:" & FechaCancel & " " & TextBox0 & Sep & TextBox50 & Sep & TextBox51 & Sep & TextBox4 & Sep & TextBox5 & Sep & TextBox10 & Sep & TextBox6 & Sep & TextBox11 & Sep & TextBox7 & Sep & TextBox8 & Sep & TextBox12
        End If
    Next x
    Print #1, "-"
    Close #1
End Sub

Saúdos e moito coidado, la cosa se vuelve a poner seria.

Un abrazo y muchas gracias como siempre.

Antoni · el 27 de enero

Te dejo una función para saber si hay algún elemento seleccionado.

Private Function Seleccionado() As Boolean
Dim x As Long
For x = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(x) Then
      Seleccionado = True
      Exit Function
   End If
Next
End Function

Y luego basta con

If ListBox1.Selected(x) Or Not Seleccionado Then

Benito Bartolomé · el 27 de enero

Hace 40 minutos , Antoni dijo:
Te dejo una función para saber si hay algún elemento seleccionado.
Private Function Seleccionado() As Boolean
Dim x As Long
For x = 0 To ListBox1.ListCount - 1
   If ListBox1.Selected(x) Then
      Seleccionado = True
      Exit Function
   End If
Next
End Function
Y luego basta con
If ListBox1.Selected(x) Or Not Seleccionado Then

Perfecto maestro, eres un genio.

Lo intente con poner un segundo condicional Select (x)= "False" y no había manera.

Moitas pola axudiña.

Te pondré un 10 de nota?