Listview displays data only rarely, seemingly randomly

[boxboxbox]

Used code from
How can I format my ListBox?
faq702-5329
to create a listview on my form. It worked fine, but now it won't show any data. It loads it, the headers are at appropriate widths, and there should be records (my sql works fine in a query), and even will give the first record in the recordset when I click on the listview.

Why won't this work? It seems to work randomly, even when I don't change anything, but then it will just stop loading properly. No error message is given

Any ideas? Thanks. Here's the code (adjusted for my data):

Private Function fLoadList()
On Error GoTo err_handle
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Variables
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim lvxobj As ListView
Dim lstItem As ListItem
Dim rs As DAO.Recordset
Dim fld As DAO.Field
Dim iColWidth As Integer
Dim i As Integer
Dim strSQL As String


Dim Sel As String
Dim Wher1 As String
Dim Wher2 As String
Dim Ord As String
Dim StatCritWhole As String
Dim TypeCritWhole As String


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Set the SQL statement for our recordsource
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'By using the SQL 'AS' keyword, we can give our columns custom names...

'example:
'strSQL = "Select * from Employees where [LastName]=" & """" & _
me!EmpLastName & """"
'WORKS!: strSQL = "select itemnumber as [id], title as [title1], askingprice as [active] from book where title like " & """" & Forms!sbinventory!txtSearchAuthor & "*" & """" & " order by itemnumber asc;"
'strSQL = "select itemnumber as [id], title as [title1], askingprice as [active] from book where (title like " & """" & Forms!sbinventory!txtSearchAuthor & "*" & """" & ") order by itemnumber asc;"

'1 is for viewing all. If it's 1, don't insert the criteria. If it's anything else, filter the listview.


'enter the criteria syntax for to filter for the status



If Me.frStatus = 1 Then
StatCritWhole = ""
ElseIf Me.frStatus > 1 And Me.frStatus < 7 Then
StatCritWhole = " AND Status = " & Me.frStatus
'enter this if I want an OnHold/ForSale option...
'ElseIf Me.frStatus = 7 Then
'StatCritWhole = "Status = 2 OR Status = 3 OR Status = 4 OR Status = 5"
End If

If Me.FrType = 1 Then 'View All Types
TypeCritWhole = ""

ElseIf Me.FrType = 2 Then 'View All Books
TypeCritWhole = " AND ((Booktype = 'Book-Used') OR (BookType = 'Book-New') OR (BookType = 'Remainder'))"

ElseIf Me.FrType = 3 Then 'View Books-Used
TypeCritWhole = " AND BookType = 'Book-Used'"

ElseIf Me.FrType = 4 Then 'View Books-New
TypeCritWhole = " AND BookType = 'Book-New'"

ElseIf Me.FrType = 5 Then 'View Remainders
TypeCritWhole = " AND BookType = 'Remainder'"

ElseIf Me.FrType = 6 Then 'View All Comics
TypeCritWhole = " AND ((BookType = 'Comic-Used') OR (BookType = 'Comic-New'))"

ElseIf Me.FrType = 7 Then 'View Comics-Used
TypeCritWhole = " AND BookType = 'Comic-Used'"

ElseIf Me.FrType = 8 Then 'View Comics-New
TypeCritWhole = " AND BookType = 'Comic-New'"

ElseIf Me.FrType = 9 Then 'View All Art
TypeCritWhole = " AND ((BookType = 'Cover Art') OR (BookType = 'Illustration Art') OR (BookType = 'Cel'))"

ElseIf Me.FrType = 10 Then 'View Cover Art
TypeCritWhole = " AND BookType = 'Cover Art'"

ElseIf Me.FrType = 11 Then 'View Illustration Art
TypeCritWhole = " AND BookType = 'Illustration Art'"

ElseIf Me.FrType = 12 Then 'View Cels
TypeCritWhole = " AND BookType = 'Cel'"

ElseIf Me.FrType = 13 Then 'View All Music
TypeCritWhole = " AND ((BookType = 'CD-Used') OR (BookType = 'CD-New') OR (BookType = 'LP-Used') OR (BookType = 'LP-New'))"

ElseIf Me.FrType = 14 Then 'View All CDs
TypeCritWhole = " AND BookType = 'CD-Used' OR BookType = 'CD-New'"

ElseIf Me.FrType = 15 Then 'View CDs-Used
TypeCritWhole = " AND BookType = 'CD-Used'"

ElseIf Me.FrType = 16 Then 'View CDs-New
TypeCritWhole = " AND BookType = 'CD-New'"

ElseIf Me.FrType = 17 Then 'View All LPs
TypeCritWhole = " AND ((BookType = 'LP-Used') OR (BookType = 'LP-New'))"

ElseIf Me.FrType = 18 Then 'View LPs-Used
TypeCritWhole = " AND BookType = 'LP-Used'"

ElseIf Me.FrType = 19 Then 'View LPs-New
TypeCritWhole = " AND BookType = 'LP-New'"

End If
'THIS takes TOO LONG FOR VIEWING ALL BOOK-USED books...try converting to a number again?

'why does it keep randomly quitting working?
'it's getting data, but not showing the list...meh can even double click to view title of
'first item in list
'That's my main problem...tried copying code from backups that work, even that stopped working.


Sel = "SELECT itemnumber as [id], ItemNumber , Author ,Title , " & _
"Publisher , Publishplace as [Place], PublishYear as [Year], Edition, AskingPrice as [Price], " & _
"Status, Quantity, BookType as [Item Type], Binding, " & _
"BookCondition as [Book Condition], JacketCondition as [Jacket Condition], " & _
"Illustrator, ISBN, Section as [Catalog], PrivateComment, PurchaseReceipt, PurchasePrice, " & _
"DateAdded, DateUpdated, askingprice as [Active] FROM Book "

Wher1 = "WHERE ((author like " & """" & Forms!sbinventory!txtSearchAuthor & "*" & """" & ") OR " & _
"(author like " & """" & " " & Forms!sbinventory!txtSearchAuthor & " " & """" & ")) AND " & _
"((title like " & """" & Forms!sbinventory!txtSearchTitle & "*" & """" & ") OR " & _
"(title like " & """" & " " & Forms!sbinventory!txtSearchTitle & " " & """" & ")) AND " & _
"((publisher like " & """" & Forms!sbinventory!txtSearchPublisher & "*" & """" & ") OR " & _
"(publisher like " & """" & " " & Forms!sbinventory!txtSearchPublisher & " " & """" & ")) AND " & _
"((itemnumber like " & """" & Forms!sbinventory!txtSearchID & "*" & """" & ") OR " & _
"(itemnumber like " & """" & " " & Forms!sbinventory!txtSearchID & " " & """" & ")) "

Wher2 = StatCritWhole & TypeCritWhole

Ord = " ORDER BY itemnumber asc;"

strSQL = Sel & Wher1 & Wher2 & Ord
Me.Text107 = Sel & Wher1 & Wher2 & Ord 'just so I can test the sql, and it does work...
'Exit Function

'WHERE (((Book.Author) Like [forms]![sbinventory]![txtsearchauthor] & "*")) OR ((([forms]![sbinventory]![txtsearchauthor]) Is Null)) OR (((Book.Author) Like " " & [forms]![sbinventory]![txtsearchauthor] & " "));
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Set up List View object, and invoke a recordset based on the SQL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set lvxobj = lvxEmployees.Object
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Clear any items in the current list.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lvxobj.ListItems.Clear

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Clear existing, then add new column headers
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'code loops through the open recordset's field names (the custom
'ones with set using the AS keyword, if you remember) and sets them
'as our ListViews columnheaders.
'We also set the column widths to be all the same, which is calculated
'by taking the width of the ListView itself, divided by the number of
'columns. I minus 20 of the end of each one, to ensure all fields are
'visible completely (not hanging over the edge of the listview).

With lvxobj.ColumnHeaders
.Clear
For i = 0 To rs.Fields.Count
For Each fld In rs.Fields
If i = 0 Then

iColWidth = 0 ' This hides the first ID column from the user, but retains it's value as the identifying property
ElseIf i = 1 Then
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 500
ElseIf i = 2 Then
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) + 200
ElseIf i = 3 Then
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) + 800
ElseIf i = 6 Then
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 800
ElseIf i = 8 Then
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 500
ElseIf i = 9 Then
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 600
ElseIf i = 10 Then
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 800
Else
iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 20
End If
.add , , fld.Name, iColWidth
i = i + 1
Next fld
Next i
End With

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Check values present in recordset
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If rs.BOF And rs.EOF Then ' And rs.EOF ADDED from other code advice
'No data has been returned .. no need to add the items to the
' list view.
Else
'Records present.. setting up list of items
'MsgBox "records present"

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Add in list items, with colour based on criteria of if the
' employee is active or not.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rs.MoveFirst

While Not rs.EOF
For i = 0 To rs.Fields.Count - 1 '-1 added from other code advice
If i = 0 Then
Set lstItem = lvxobj.ListItems.add(, , Nz(Trim(rs(i)), "")) ' Set the value of the first column of the row

' Set the Colour based on criteria
If rs("Active") = 0 Then
lstItem.ForeColor = vbBlack ' Black if not active
Else
lstItem.ForeColor = vbRed ' Red if active
End If
ElseIf i < rs.Fields.Count - 1 Then '-1 added
lstItem.SubItems(i) = Nz(Trim(rs(i)), "") ' set the subsequent columns, known as subitems.

'Repeat Colour setting based on criteria, for the subitems
If rs("Active") = 0 Then
lstItem.ForeColor = vbBlack ' Black if not active
Else
lstItem.ForeColor = vbRed ' Red if active
End If
Else
End If
Next i
rs.MoveNext
Wend
End If


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Close off & Cleanup
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
rs.Close
Exit Function
err_handle:
Select Case Err.Number
Case 0
'ignore, not an Error
Case Else
'Handle error Appropriately.
MsgBox Err.Description
End Select
End Function

 

[willir]

but now it won't show any data...work randomly

You are going to have to put your debug hat on for this. We have to determine several things...
- Is the code actually running? I resolved a problem yesterday where the code the tek-tipster had entered was not being run because of problem with the named control used to run the code.
- Is the code out-of-scope? The function is listed as Private
- If the code is running, but your data is not be displayed, where is the logic failing?
- The error handler is not being run which suggests no error is encountered - interesting.

Comment out the error handler...

Private Function fLoadList()
[COLOR=blue yellow]'[/color]On Error GoTo err_handle

You need to comment out the error handler so you can work with the code. REMEMBER to remove the comment later so the error handler is in place.

Then place a ....
STOP
command near the top of the code.

If you don't hit the STOP when you run the code, the code is not being executed. Check scope and check names.

If you hit the STOP, use F8 to step through the code.

Hopefully, you will see where the logic is not working the way you expect.

Richard

 

[boxboxbox]

Hi Richard,

Thanks for your reply.

I've tried it without the error handling and it does not produce an error. If I tell it to put a message box at the end of the code, signifying completion, it will fire, even though no data shows.

The message box here:
If rs.BOF And rs.EOF Then
Else
'Records present.. setting up list of items
'MsgBox "records present"

fires, implying to me, at least, that records are available, even if not showing up.

Also, I tried changing it to a Public function, but still no love.

I say that it works randomly - it seems to be affected by changing the code. For instance, it worked fine, and then I added some more code. Then it stopped, so I took out the code. It still didn't work. Even a backup I had made when it did work (and that I had tested) stopped working. And the code I added and then removed would be something minor, like a message box...

I have not tried the STOP command yet, so I will try that now...Thanks again...

 

[boxboxbox]

I don't know.

The data is getting there...If I do something like below, then it tells me the author for the first item, and the column/field number, then the title and column/field number for all the sub items. They match the query set, it just won't show in the ListView itself.

I'm using Access 2000 on Win2K prof; the Listview Activex was 6.0. Any one with good luck on 5.0?




While Not rs.EOF
For i = 0 To rs.Fields.Count '-1 added from other code advice
If i = 0 Then
Set lstItem = lvxobj.ListItems.add(, , Nz(Trim(rs(i)), "")) ' Set the value of the first column of the row

' Set the Colour based on criteria
If rs("Active") = 0 Then
MsgBox rs("author") & i
lstItem.ForeColor = vbBlack ' Black if not active
Else
MsgBox rs("author") & i
lstItem.ForeColor = vbRed ' Red if active
End If
ElseIf i < rs.Fields.Count Then '-1 added
lstItem.SubItems(i) = Nz(Trim(rs(i)), "") ' set the subsequent columns, known as subitems.

'Repeat Colour setting based on criteria, for the subitems
If rs("Active") = 0 Then
MsgBox rs("Title") & i
lstItem.ForeColor = vbBlack ' Black if not active
Else
MsgBox rs("Title") & i
lstItem.ForeColor = vbRed ' Red if active
End If
Else
MsgBox rs("Title") & "hates me life..."
End If

Next i
rs.MoveNext
Wend

 

[boxboxbox]

Ahah:

If i = 0 Then
Set lstItem = lvxobj.ListItems.add(, , Nz(Trim(rs(i)), "")) 'Set the value of the first column of the row

'AND

ElseIf i < rs.Fields.Count Then '-1 added
lstItem.SubItems(i) = Nz(Trim(rs(i)), "")

It says that rs(i) is not an item found in this collection...
Still don't know why there wouldn't be an error, or how to fix it...

 

[boxboxbox]

Well, even when I get rid of all the ifs and i's and all that and just insert it manually:

Set lstItem = lvxobj.ListItems.add()
lstItem.Text = Nz(Trim(rs!id))
lstItem.SubItems(1) = Nz(Trim(rs!ItemNumber))
lstItem.SubItems(2) = Nz(Trim(rs!Author))
etc...

it's still not working. I've had some luck recreating it on a new form, so I guess I'll try that again before giving up.
Thanks for all your thoughts, and let me know if you have anything brilliant to save this...