Populate a Listbox from an Access database

[austenr]

I found this on the web and it does what I think I want it to do. I want to be able to read an ACCESS db and populate a list box. Not sure if it is an EXCEL macro or an ACCESS one. Could someone please help? If you can help, could you let me know what needs to be done to make ot work? Thanks


Sub Populate_Dimension_ListBox()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim StDB As String, stConn As String, stSQL As String
Dim xlCalc As XlCalculation
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim vaData As Variant
Dim j As Long, x As Long, i As Long, y As Long
Dim dbWidth As Double
'In order to increase performance
With Application
xlCalc = .Calculation
.EnableEvents = False
.ScreenUpdating = False
End With
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets(1)
'Instantiate the Connectionobject
Set cnt = New ADODB.Connection
' path to the database
StDB = ThisWorkbook.Path & "\" & "Test.mdb"
' Create the connectionstring
stConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & StDB & ";"
'Create the SQL-statement
stSQL = "SELECT * From tblDATA"
With cnt
j = .Fields.Count ' Get the number of fields
i = .RecordCount ' Gets the number of records
Set .ActiveConnection = Nothing ' Disconnect the recordset
End With
'Close the connection
cnt.Close
With ws.Sheet
.UsedRange.Clear ' Clear the worksheet
'Write the fieldnames to the first row
For x = 0 To j - 1
.Cells(1, x + 1).Value = rst.Fields(x).Name
Next x
'Dump the records into the worksheet
.Cells(2, 1).CopyFromRecordset rst
'Set the range for the Listbox's Source.
Set rnData = .Range(.Cells(2, 1), .Cells(i, j))
End With
'Close the recordset
rst.Close
'Adjust the columnwidth which will be used to manipulate the columnwidth for the listbox
rn.Data.Offset(-1, 0).Columns.AutoFit
'Set up the width of the columns for the Listbox
For y = 1 To j
dbWidth = dbWidth + (rnData(1, y).Columns.Width + 40)
Next y
' Manipulate the Listbox's properties and show the form
With frmData
With .ListBox1
.Clear
.BoundColumn = j
.ColumnCount = j
.ColumnHeads = True
.Width = dbWidth
.RowSource = rnData.Parent.Name & "!" & rnData.Address
.ListIndex = -1
End With
.Show vbModeless
End With
'Release objects from memory
Set rst = Nothing
Set cnt = Nothing
'Restore the settings
With Application
.Calculation = xlClac
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

[Ken Puls]

Hey Austen,

It's an Excel macro. You guessed right!

You'll need to update this part:



StDB = ThisWorkbook.Path & "\" & "Test.mdb"
' Create the connectionstring
stConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & StDB & ";"
'Create the SQL-statement
stSQL = "SELECT * From tblDATA"

Change the "Test.mdb" file to your database's filename. (This one assumes that the mdb file is in the same directory as your workbook, so you many need to change that.)

Update the stSQL line. You'll need to change the "tblDATA" part to the name of your table.

I think that should do it, although right near the end, this looks wrong.
xlClac

Should probably be xlCalc?

Good luck!

[austenr]

Thanks...Got a run time error on this line.."Operation not allowed when the object is closed..."


j = .Fields.Count ' Get the number of fields

[Ken Puls]

Hey Austen,

Okay, I had to clean up a bunch of it. I assumed that you'd found it somewhere where the author had tested it, but that doesn't seem to be the case.

At any rate, I have changed it a bit. This works to pull the data into a userform listbox, which isn't what the original one was doing. It was putting it into a worksheet listbox. I just found this one easier to troubleshoot the ADO connection issues. We can certainly set it back, but this does work.

Give this a shot. Userform name is frmData, and listbox is called ListBox1...


Private Sub UserForm_Initialize()
Dim cnt As ADODB.Connection
Dim rst As New ADODB.Recordset
Dim strDb As String, strSQL As String
Dim xlCalc As XlCalculation
Dim j As Long, x As Long
'SET YOUR VARIABLES HERE:
'Path to the database and SQL-statement to execute
strDb = "C:\temp\mileage.mdb"
strSQL = "SELECT tblMileage.* FROM tblMileage"
'In order to increase performance
With Application
xlCalc = .Calculation
.EnableEvents = False
.ScreenUpdating = False
End With
'Establish and ADO connection
Set cnt = New ADODB.Connection
'Create the connection string
cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDb & ";"
'Retrieve the recordset and count fields & records
rst.Open strSQL, cnt
'Add the items to the listbox
With frmdata
For x = 1 To rst.Fields.Count - 1
.ListBox1.AddItem rst.Fields(x).Name
Next x
End With
'Close the recordset, connection and release objects from memory
With rst
.Close
.ActiveConnection = Nothing
End With
cnt.Close
Set rst = Nothing
Set cnt = Nothing
'Restore the settings
With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


You'll need to update the database path and the SQL query.

Let me know.

[austenr]

Thanks Ken. It is late so I will give it a try tomorrow. Thanks a bunch again...

[austenr]

Having trouble with this statement:

rst.Open strSQL, cnt

Not sure if it cannot find the db or the table.

The error is:

"Cannot find input table or query"

[Ken Puls]

Hi Austen,

Sorry for the late reply, was in meetings all day today. The issue isn't with finding your database. If that was an issue, it would have errored on the line above that one.

I would suggest that the issue is with the SQL query. To test that, I would create the query in Access, making sure it works. After I had that, I'd change to SQL view, copy the query, and paste it in to the code.

In the code I used, (shown below,) you'd want to change the BOTH references to tblMileage to your table name.


strSQL = "SELECT tblMileage.* FROM tblMileage"

Hope that helps!

[austenr]

Hmmm..Now I get an Automation error. Does not cancel but seems to end with that. If you step through it you get it at the end.

[Ken Puls]

Really? That is weird...

You do have a reference set to Microsoft ActiveX Data Objects 2.x Library, don't you? Of course you do, or you wouldn't get that far.

What line, exactly, does it bomb on when you step through it?

[austenr]

Does not bomb on any line. Just kept hitting F5 and it steps through it all then I get the message. Kind of strange I know. Is there some error handling we could put in?

[Ken Puls]

So it gets all the way to "End Sub" before it generates the error? That is really weird.

As far as error handling, I don't know what we could throw in that would help. I didn't run into that issue on my machine, so I'm confused.

What version of Excel/Access are you running on?

[austenr]

Office XP

[Ken Puls]

Okay, I'm on 2003 but I don't think that should make any difference. I wonder if you could upload a small sample workbook and very small sample database. If not, I can do that tonight. It'll take me about 12 hours to get there though.

If anyone else has seen this before, please chip in! :)

[austenr]

I will post a sample later today. Thanks for your help. There is not an urgancy except for me to figure it out.

[austenr]

Here is my database sample. Also my EXCEL file. Thanks Ken

[austenr]

EXCEL File

[Ken Puls]

Hey Austen,

Okay, a couple of things.

I downloaded both your files, and used them to test the code. Definately ran into a couple of issues, around the SQL query and the code placement.

The actual table name in my database was called "tblMileage". Yours is "Austen". The code that you were using was looking for "tblAusten". I always preface my tables and queries with notation as it makes it easier to follow code later on.

I modified your SQL query to:

strSQL = "SELECT * FROM Austen"

Also, this code was designed to run in a listbox on a userform. We can fix that and make it a worksheet listbox if you like, but it was a staring point. I added a userform (called frmData), with a listbox (ListBox1), and a commandbutton to close the form. Just to make it easy, I also added a button to your worksheet to call up the userform.

The macro above goes in the "Userform_Initialize" event, so that the listbox is populated when the form is opened.

Sample of the Excel file is attached. Let me know if it still works or not, and if you need to change anything. Definately works here. :)

[Ken Puls]

Oh yeah! Forgot this...

I changed the following line to start at 0 so that the listbox populates starting at the first field as well.


For x = 0 To rst.Fields.Count - 1

[austenr]

That got it. Thanks

[Ken Puls]

Cool! :thumb

It's all good in a userform?

[austenr]

Yep..Seems to Be. Thanks so much for your help on this. BTW What does CMA stand for behind your name?

[Ken Puls]

No problem! It was an interesting challenge!

CMA is a Certified Management Accountant (http://www.cmabc.com/home/index.html). It's a Canadian designation which is focussed more on industry (internal controls, human resources, IT) than the other Tax Return/Audit based designations.

Should we mark this one solved? ;)

[austenr]

Please do...

[Ken Puls]

Done!

You know that you can do this yourself in future though? See the note in my sig. ;)

Generally I figure it's best to let the asker mark it closed, as only they know when the question is truly answered. :yes

Cheers,

[austenr]

Well all is not good...After further testing with another file, it only writes the headers to the listbox then stops with no error.

[Ken Puls]

How much did you want in the listbox? You want all the headers and all the rest of the info? Sort of a columnar listbox?

[austenr]

Hi Ken,

Yes the headers and the info in a columnar format. Also, while you are here, I am trying to use the code you have on your site that you can add records from EXCEL to ACCESS. I am getting the error "could not find installable ISAM". I have not altered your code in any way except cells B1 and B2. Any ideas?

[Ken Puls]

Hey Austen,

Yep, you need to modify A3:F3 (or more/less columns) to be consistent with your table headers. Don't forget to put in the named ranges as explained below that pic too.

I've never seen that error, though. You're picking up some good ones here!

I'll work on the listbox one again tonight/this weekend.

Cheers!