How to Save listbox items to .csv file

[bittu2016]

Hi all ,
I have a data the data in the listbox and I want to export all the items in the listbox to an excel . could anyone please send me the script

Thanks
Bittu

[Kenneth Hobs]

In new workbook, add a userform, listbox and commandbuttons. Add this to the userform code. Change ken.csv, to suit. Delete the initial filling of the range used in testing.

Private Sub UserForm_Initialize()
Dim c As Range, r As Range
'Fill some dummy data.
Set r = Range("A1:C10")
For Each c In r
c.Value = c.Address
Next c

With ListBox1
.ColumnCount = r.Columns.Count
.List = r.Value
End With
End Sub


Private Sub CommandButton1_Click()
Dim fn$, wb As Workbook, i&
fn = Environ("temp") & "\ken.csv"

Set wb = Workbooks.Add
i = Worksheets.Count
Worksheets.Add after:=Worksheets(i)
With ListBox1
ActiveSheet.Range("A1").Resize(.ListCount, .ColumnCount) = .List
End With
ActiveSheet.SaveAs fn, xlCSV
'wb.Close False

Unload Me
End Sub

[bittu2016]

Thanks Kenneth,
It is working with dummy data , but in my listbox there is already a data which will be loading from the database and the listbox names are :
ListBoxAcctListBoxAddr2
ListBoxAddr
could you please let me know the script , instead of dummy data I want to test with live data from the listbox ?

Thanks
Bittu

[Kenneth Hobs]

I see in our PM that you are using ADO to fill two listboxes. If is best to keep thread discussions in the thread. When pasting code, click the # icon on the toolbar and paste between tags.

You don't need my Initialize event code since you are filling the listboxes with ADO. ADO can be sent to a CSV file directly or do it as I showed. In my CommandButton1 code, simply replace ListBox1 with one of your two listbox names.

I don't know if you want a CSV for each listbox or both in one. Both in one only makes sense if they have the same number of column and field types.

[bittu2016]

Hi Kenneth,
Here is my complete script of loading listboxes with data from the database, I want all the 3 listboxes to be export to csv ...
could you let me know the changes
Thanks


Private Sub cbLoad_Click()Dim current_dti As Double
Dim i As Integer
Dim userid As String
Dim rstRegulate As ADODB.Recordset
Dim userid_where As String
Dim query As String
ListBoxFolders.Clear
ListBoxAddr.Clear
If txtuserid.Text = "" Then
MsgBox "Please enter a user id"
Else
current_dti = ConvertDateToSAS(Date)
userid = UCase(Me.txtuserid.Value)
Set rstRegulate = New ADODB.Recordset
If userid = "USERSABC" Then
userid_where = ""
ElseIf gQueue = "NewAcct" And gNAFqueue = "REG" Then
userid_where = " and action.added_by = '" & userid & "'"
Else
userid_where = " and holder.holder_placed_by = '" & userid & "'"
End If
If gQueue = "NewAcct" And gNAFqueue = "REG" Then
query = "select cust_num, status, a_rep_dt, uncolld_amt, holder_amt, holder_comment, cust_nm, cust_nm_ln2, cust_nm_ln3, cust_nm_ln4, adr_line_1_txt, " _
& " adr_line_2_txt, adr_line_3_txt, adr_line_4_txt, city_nm, state, zip_cd, 'BC' as load_table from '"
End If
Set rstRegulate = ExecuteSQL(query)
If gDBError = True Then
GoTo cbLoad_Click_Exit
End If
'Open query
i = 0
If (rstRegulate.EOF = False And rstRegulate.BOF = False) Then
rstRegulate.MoveFirst
Do
Me.ListBoxFolders.AddItem
Me.ListBoxAddr2.AddItem
Me.ListBoxAddr.AddItem
If gQueue = "NewAcct" And gNAFqueue = "REG" Then
Me.ListBoxFolders.List(i, 3) = Format(rstRegulate![uncolld_amt], "$#,##0.00") 'Balance
Me.ListBoxFolders.List(i, 4) = Format(rstRegulate![holder_amt], "$#,##0.00")
Me.ListBoxFolders.List(i, 5) = rstRegulate![holder_comment]
If IsNull(rstRegulate![acct_clsd_dt]) = False Then Me.ListBoxFolders.List(i, 6) = Format(ConvertDateFromSAS(rstRegulate![acct_clsd_dt]), "m/d/yyyy")
Me.ListBoxFolders.List(i, 7) = rstRegulate![Status]
Else
Me.ListBoxFolders.List(i, 1) = ConvertDateFromSAS(rstRegulate![h_plc_dt])
Me.ListBoxFolders.List(i, 3) = Format(rstRegulate![trxn_sum], "$#,##0.00")
Me.ListBoxFolders.List(i, 4) = Format(rstRegulate![holder_amt], "$#,##0.00")
Me.ListBoxFolders.List(i, 5) = rstRegulate![holder_comment]
Me.ListBoxFolders.List(i, 6) = Format(ConvertDateFromSAS(rstRegulate![h_exp_dt]), "m/d/yyyy")
Me.ListBoxFolders.List(i, 7) = rstRegulate![holder_type]
Me.ListBoxAddr2.List(i, 4) = Format(ConvertDateFromSAS(rstRegulate![dep_dt]), "m/d/yyyy")
Me.ListBoxAddr2.List(i, 5) = rstRegulate![holder_type]
Me.ListBoxAddr2.List(i, 8) = rstRegulate![holder_placed_by] & " " & rstRegulate![empNm]
End If
Me.ListBoxFolders.List(i, 0) = "Not Printed"
Me.ListBoxFolders.List(i, 2) = rstRegulate![acct_num]
Me.ListBoxAddr2.List(i, 3) = rstRegulate![load_table]
Me.ListBoxAddr2.List(i, 7) = rstRegulate![cust_num]
Me.ListBoxFolders.List(i, 9) = Format(ConvertDateFromSAS(rstRegulate![a_rep_dt]), "m/d/yyyy")
'Cust Name
If IsNull(rstRegulate![cust_nm]) Then
ListBoxAddr.List(i, 0) = ""
Else
ListBoxAddr.List(i, 0) = stripquotes(rstRegulate![cust_nm])
End If
If IsNull(rstRegulate![cust_nm_ln2]) Then
ListBoxAddr.List(i, 1) = ""
Else
ListBoxAddr.List(i, 1) = stripquotes(rstRegulate![cust_nm_ln2])
End If
If IsNull(rstRegulate![cust_nm_ln3]) Then
ListBoxAddr.List(i, 2) = ""
Else
ListBoxAddr.List(i, 2) = stripquotes(rstRegulate![cust_nm_ln3])
End If
If IsNull(rstRegulate![cust_nm_ln4]) Then
ListBoxAddr.List(i, 3) = ""
Else
ListBoxAddr.List(i, 3) = stripquotes(rstRegulate![cust_nm_ln4])
End If
'Address
If IsNull(rstRegulate![adr_line_1_txt]) Then
ListBoxAddr.List(i, 4) = ""
Else
ListBoxAddr.List(i, 4) = stripquotes(rstRegulate![adr_line_1_txt])
End If
If IsNull(rstRegulate![adr_line_2_txt]) Then
ListBoxAddr.List(i, 5) = ""
Else
ListBoxAddr.List(i, 5) = stripquotes(rstRegulate![adr_line_2_txt])
End If
If IsNull(rstRegulate![adr_line_3_txt]) Then
ListBoxAddr.List(i, 6) = ""
Else
ListBoxAddr.List(i, 6) = stripquotes(rstRegulate![adr_line_3_txt])
End If
If IsNull(rstRegulate![adr_line_4_txt]) Then
ListBoxAddr.List(i, 7) = ""
Else
ListBoxAddr.List(i, 7) = stripquotes(rstRegulate![adr_line_4_txt])
End If
If IsNull(rstRegulate![city_nm]) Then
ListBoxAddr2.List(i, 0) = ""
Else
ListBoxAddr2.List(i, 0) = stripquotes(rstRegulate![city_nm])
End If
If IsNull(rstRegulate![State]) Then
ListBoxAddr2.List(i, 1) = ""
Else
ListBoxAddr2.List(i, 1) = stripquotes(rstRegulate![State])
End If
If IsNull(rstRegulate![zip_cd]) Then
ListBoxAddr2.List(i, 2) = ""
Else
ListBoxAddr2.List(i, 2) = stripquotes(rstRegulate![zip_cd])
End If
'Concatenated address for line 7
Me.ListBoxFolders.List(i, 8) = ListBoxAddr.List(i, 0) & " " & ListBoxAddr.List(i, 1) & " " & ListBoxAddr.List(i, 2) & " " & _
ListBoxAddr.List(i, 3) & ", " & ListBoxAddr.List(i, 4) & " " & ListBoxAddr.List(i, 5) & " " & ListBoxAddr.List(i, 6) & " " & +
ListBoxAddr.List(i, 7) & " " & ListBoxAddr2.List(i, 0) & " " & ListBoxAddr2.List(i, 1) & ", " & ListBoxAddr2.List(i, 2)
i = i + 1
rstRegulate.MoveNext
Loop Until rstRegulate.EOF
Me.ListBoxFolders.ListIndex = 0
Me.ListBoxFolders.SetFocus
ListBoxFolders.ColumnWidths = "60;50;70;70;70;70;50;70;150;0;"
Else
MsgBox ("None to be printed")
GoTo cbLoad_Click_Exit
End If
End If
ListBoxFolders.Selected(0) = True
cbLoad_Click_Exit:
On Error Resume Next
rstRegulate.Close
Set rstRegulate = Nothing
Exit Sub
cbLoad_Click_Err:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
Resume cbLoad_Click_Exit
End Sub

[Kenneth Hobs]

Please edit your pasted code and replace the QUOTE tags with CODE tags. You may need to redo it to maintain the code structure.

It is not clear to me if your listboxes have column headings or not.

Without getting into the ADO part, this should be easy enough once the listboxes are filled. Call it where needed.

Private Sub toCSV()
Dim fn$, wb As Workbook, r As Range
fn = Environ("temp") & "\ken.csv"
Set wb = Workbooks.Add
With ListBoxFolders
Range("A1").Resize(.ListCount, .ColumnCount) = .List
End With
With ListBoxAddr2
Set r = Cells(Rows.Count, "A").End(xlUp).Offset(1)
r.Resize(.ListCount, .ColumnCount) = .List
End With
With ListBoxAddr
Set r = Cells(Rows.Count, "A").End(xlUp).Offset(1)
r.Resize(.ListCount, .ColumnCount) = .List
End With
ActiveSheet.SaveAs fn, xlCSV
'wb.Close False
'Unload Me
End Sub

[bittu2016]

Great Keneth !!
It is working and this is what exactly to my expectation , last final QQ but not mandatory, how to populate the header in .csv or where to define the column headers in the script ?


Private Sub CommandButton1_Click()
Dim fn$, wb As Workbook, r As Range
fn = Environ("temp") & "\RegCC_holds.csv"
Set wb = Workbooks.add
With ListBoxHolds
Range("A1").Resize(.ListCount, .ColumnCount) = .List
End With
ActiveSheet.SaveAs fn, xlCSV
End Sub

[Kenneth Hobs]

Column headers in a listbox is only doable when the RowSource property is used or it is added in another way. If you have just a few static header/columns/fieldnames, that is easily added to A1 and set your first list to A2. Or, you can use ADO to fill the first row at A1.

[bittu2016]

Thank you Kenneth for your response,
I tried adding header names ( acct_num, amount, address ) but not working , Could you send me the code on adding the header columns

Thanks and appreciate
Bittu

[Kenneth Hobs]

Private Sub toCSV2()
Dim fn$, wb As Workbook, r As Range, t() As String
fn = Environ("temp") & "\ken.csv"
t = Split("acct_num,amount,address", ",")
Set wb = Workbooks.Add
'Title/Column/Field names
Range("A1").Resize(, UBound(t) + 1) = t
With ListBoxFolders
Range("A2").Resize(.ListCount, .ColumnCount) = .List
End With
With ListBoxAddr2
Set r = Cells(Rows.Count, "A").End(xlUp).Offset(1)
r.Resize(.ListCount, .ColumnCount) = .List
End With
With ListBoxAddr
Set r = Cells(Rows.Count, "A").End(xlUp).Offset(1)
r.Resize(.ListCount, .ColumnCount) = .List
End With
ActiveSheet.SaveAs fn, xlCSV
'wb.Close False
'Unload Me
End Sub

[bittu2016]

Great !! its working ..
One last question , can it be a possible to delete or update the output .csv file ( "temp") & "\ken.csv" ) , every after the button click .
Ex: first time It will be saved as a new report as Ken.csv and when I execute the script for the next time it is showing as "file exists do you want to replace" not mandatory just an option to make application more easy.

Thanks for your help
Bittu

[Kenneth Hobs]

You can set application.DisplayAlerts=False and True after the save to stop that. Or Kill(), the file before the save, or name it something else.

[bittu2016]

thank you