Query information from certain records

[gmaxey]

Hi,

I dabble a bit in Word VBA and from time to time I need to get information from an Excel file. I don't understand all of the mechanics of doing that and I usually just adapt code that I have found posted on the internet to meet my needs. I am currently working on a Word userform that contains five linked listboxes (i.e., selection in first box determines list entries in second box, selection in second box determines list entries in third box and so on.).

Reduced in scope and very simplistic, my Excel file might look like this:

1 A Dogs
2 A Cats
3 A Birds
4 B Boxer
5 B Collie
6 C Siamese
7 C Tabby
8 D Parrot
9 D Bluebird

When the form is displayed all of the items coded "A" are populated in listbox1. If the user clicked "Dogs" then all of the items coded "B" are populated in listbox 2.

I haved some code that is working. It takes the listbox and "Parent_ID" which would be "A, B, C, etc." using the simple example above as arguments, but it uses the "ADODB.recordset" process and I was wondering if was a simplier way using only Excel methods to do the same thing. Code follows. Thanks.

[VBA]Option Explicit
Const m_Directory = "D:\Data Stores"
Dim m_strFilterField As String
Dim m_strFilterValue As String
Dim m_strQuery As String
'****************************************************************
Sub FillListBox(ByRef List As ListBox, ByVal Parent_ID As String)
Dim arrData() As Variant
Dim lngRows As Long
Dim lngCols As Long
Dim lngRow As Long
Dim lngCol As Long
Dim oRS As New ADODB.Recordset

Application.ScreenUpdating = False
Set oRS = GetList(Parent_ID)
lngRows = oRS.RecordCount
lngCols = oRS.Fields.Count

'No matching list entries found so clear the list manually.
If lngRows = 0 Then
List.Clear
Else
'Set the userform listbox column count and hide columns 1, 2 and 3
List.ColumnCount = lngCols
List.ColumnWidths = "0,0,0"
ReDim arrData(lngRows - 1, lngCols - 1)
For lngRow = 0 To lngRows - 1
For lngCol = 0 To lngCols - 1
arrData(lngRow, lngCol) = oRS(lngCol)
Next lngCol
oRS.MoveNext
Next lngRow
'Load data into ListBox1
List.List() = arrData
End If

'Release Objects
Set oRS = Nothing
End Sub 'FillListBox
'***********************************************************
Function GetList(ByVal ParentID) As Object
' Purpose: Retrieves data for a List from LISTS.CSV by ParentID
' Assumptions: Lists.csv has entries for the ParentID requested.
' Inputs: ParentID - A string representing the List to retrieve.
' Returns: A recordset object containing the fields returned.
m_strQuery = "Select * from [LISTS#CSV]"
m_strFilterField = "Parent_ID"
m_strFilterValue = UCase(ParentID)
Set GetList = CreateObject("ADODB.Recordset")
QueryDB GetList, m_strQuery, "", m_strFilterField, m_strFilterValue, True
End Function
'***********************************************************
Function GetListItem(ByVal UID) As Object
' Purpose: Retrieves data for a List from LISTS.CSV by UID
' Assumptions: Lists.csv has a unique entry for the UID requested.
' Inputs: ParentID - A string representing the List to retrieve.
' Returns: A recordset object containing the fields returned.
m_strQuery = "Select * from [LISTS#CSV]"
m_strFilterField = "UID"
m_strFilterValue = UCase(UID)
Set GetListItem = CreateObject("ADODB.Recordset")
QueryDB GetListItem, m_strQuery, "", m_strFilterField, m_strFilterValue, True
End Function
'***********************************************************
Function QueryDB(oRS_Passed As Object, strQuery As String, strSortField As String, strFilterField As String, strFilterValue As String, bExactMatch As Boolean)
' Purpose: Retrieves data from the database.
' Assumptions: strConnect is a global that has been set.
' Inputs:
' oRS_Passed - A recordset object to be populated by Query.
' strQuery - The query to execute.
' strSortField - field name to sort on.
' strFilterField - field name by which the result set should be limited.
' strFilterValue - value to filter the above field name by.
' bExactMatch - Boolean specifying whether the query be an = or like query.
'
' Returns: A recordset object containing the records returned.
Dim strConnect As String
Dim oConnection As Object
Dim strCompositeQuery
Dim bRtnStatus
Const adUseClient = 3
Const adOpenStatic = 3
Const adReadOnly = 1
Const adCmdText = 1
Const OPERATOR_OR = "||"
Const OPERATOR_AND = "&&"
bRtnStatus = True
Set oConnection = CreateObject("ADODB.Connection")
'When a directory has not been specified by the user, assume default directory.
If strConnect = "" Then
strConnect = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & m_Directory & ";Extensions=csv,txt;Persist Security Info=False;Mode=Read;"
End If
oConnection.ConnectionString = strConnect
oConnection.Open
oRS_Passed.CursorLocation = adUseClient
'Using the filter parameters passed - generate a where clause appropriate to the filter value presented.
If UCase(strFilterValue) <> "NULL" Then
strFilterValue = Replace(LCase(strFilterValue), "'", "''")
End If
If strFilterField <> "" Then
If UCase(strFilterValue) = "NULL" Then
strCompositeQuery = strQuery & " where " & strFilterField & " IS NULL"
Else
'If explicitly requested to be an exact match and no wildcard chars specified, use exact match, i.e. =, in the where clause.
If bExactMatch And (InStr(strFilterValue, "%") = 0) Then
strCompositeQuery = strQuery & " where LCase(" & strFilterField & ") = '" & strFilterValue & "'"
Else
If (InStr(strFilterValue, "%") <> 0) Then
strFilterValue = Replace(strFilterValue, OPERATOR_OR, "' OR LCase(" & strFilterField & ") LIKE '")
strFilterValue = Replace(strFilterValue, OPERATOR_AND, "' AND LCase(" & strFilterField & ") LIKE '")
strCompositeQuery = strQuery & " where LCase(" & strFilterField & ") LIKE '" & strFilterValue & "'"
Else
strCompositeQuery = strQuery & " where LCase(" & strFilterField & ") LIKE '" & strFilterValue & "%'"
End If 'Not (Instr...
End If 'bExactMatch
End If
Else
strCompositeQuery = strQuery
End If
'If a sort field specified, add an order by clause.
If strSortField <> "" Then strCompositeQuery = strCompositeQuery & " Order by " & strSortField
On Error Resume Next
oRS_Passed.Open strCompositeQuery, oConnection, adOpenStatic, adReadOnly, adCmdText
oRS_Passed.ActiveConnection = Nothing
oConnection.Close
'We assume that if the oConnection.close fails, that there was not a successful retrieve of the recordset in the first place.
If Err.Number > 0 Then
bRtnStatus = False
End If
On Error GoTo 0
Set oConnection = Nothing
QueryDB = bRtnStatus
End Function[/VBA]

[p45cal]

I've had a play with this in Word, with 2 listboxes, and it seems quite slick.
Are you asking for a totally Excel solution, so that your application is essentially an Excel application?
I'm not sure you'd do any better; It queries Lists.csv, and as far as I know, a .csv file is just that, and I don't think there's anything in it that makes it specifically an Excel file except that in your computer's registry .csv files open in Excel by default.

For trial purposes, I had a userform with only the two listboxes and here's the code I used:[vba]Private Sub ListBox1_Change()
Set xxx = ListBox1
Select Case ListBox1.Value
Case "Cats": PID = "C"
Case "Dogs": PID = "B"
Case "Birds": PID = "D"
End Select
FillListBox ListBox2, PID
End Sub
[/vba]I manually adjusted column widths to
15 pt;30 pt
for both listboxes, and commented out the line
List.ColumnWidths = "0,0,0"
in the code. I also added headers to the Lists.csv file.

[gmaxey]

p45cal,

No. I am not looking for a complete Excel solution. It would still be a marriage between Word and Excel. What I was hoping to find was an Excel piece that didn't use the "ADODB.recordset" object which I really have no clue how it works.

In the larger project I was provided the List.csv file. Like you, I don't see anything in it that makes it a csv file. It opens in Excel like any of the other very limited Excel files that I have.

It seems like it would be much simplier if I could just put everything in the Excel file into one big multi-demensional array and then build a single array to populate the list. Something like this:

arrBig() = All used range data in Excel

For i = 0 To UBound(arrBig)
If arrBig(i, 1) = "A" Then
arrList.AddItem = arrBig(i, 2)
End If
Next i

List.List() = arrList

If I am not making sense then it is because I am a nub with Excel. If what I have proposed would work but would be a Rube Goldberg method of doing what "ADODB.recordset" is already there for and meant to do then OK.

Thanks.

[p45cal]

I was provided the List.csv file. Like you, I don't see anything in it that makes it a csv file.

Rather it's the other way round, the Lists.csv is nothing but a plain text file (comma separated variables) - not related at all to Excel. It opens in Excel only because in many people's Windows registry it says to open it in Excel, but it can be edited in Notepad.

So, I wonder whether a Word file, needing to open an instance of Excel would really be simpler than the recordset solution. Certainly it can be done, but I feel you might be doing it so that you can see/understand what's going on.

Does the Lists.csv file that you are provided with change on a regular/frequent basis?

[gmaxey]

p45Cal,

...but I feel you might be doing it so that you can see/understand what's going on.

This sort of nails it. I am a dabbler in Word and a nub with Excel. Still, I can make sense out of what limited Excel code I have used to populate Word listboxes.

I don't have a clue what is going on with this "ADODB" process. I don't even know what it is.

Thanks.