PDA

View Full Version : How to Save listbox items to .csv file



bittu2016
12-03-2016, 07:35 PM
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
12-03-2016, 09:57 PM
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
12-03-2016, 10:31 PM
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
12-04-2016, 07:38 AM
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
12-04-2016, 10:25 AM
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
12-04-2016, 10:37 AM
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
12-04-2016, 12:46 PM
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
12-04-2016, 12:58 PM
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
12-06-2016, 01:52 PM
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
12-06-2016, 05:31 PM
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
12-06-2016, 07:58 PM
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
12-06-2016, 08:04 PM
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
12-06-2016, 08:07 PM
thank you