D
diamond
Hello. I'm trying to populate a multicolumn listbox with a ADO recordest
from mdb. I came so far with code which works for 1 and 2 columns, but i cant
make it work for 3 columns. it keeps reporting Type mismatch .List =
Application.Transpose(pArray)
Code:
Private Sub ListBox1_Click()
'Option Explicit
'Set reference to the Microsoft ActiveX Data Objects x.x Library!
'Global constants required
Const glob_sdbPath = "C:\ifran.mdb"
Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
glob_sdbPath & ";"
Dim rcArray As Variant
Dim pArray As Variant
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim pSQL As String
Dim sSQL As String
If ListBox1.ListIndex = 0 Then
'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT Predmet, id_predmet FROM 192 ORDER BY predmet;"
pSQL = "SELECT program, smer, id_vsi FROM stari ORDER BY program, id_vsi;"
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows
rst.Close
rst.Open pSQL, cnt
pArray = rst.GetRows
Set rst = Nothing
With Me.ListBox4
.Clear
.ColumnCount = 3
.ColumnWidths = "150;150;30"
.List = Application.Transpose(pArray)
.ListIndex = -1
End With
'Place data in the listbox
With Me.ListBox5
.Clear
.ColumnCount = 2
.ColumnWidths = "310;30"
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
'Close ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
ElseIf ListBox1.ListIndex = 1 Then
'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT Predmet, id_predmet FROM 196 ORDER BY predmet;"
pSQL = "SELECT program, id_vsi FROM prenovljeni ORDER BY program, id_vsi;"
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows
rst.Close
rst.Open pSQL, cnt
pArray = rst.GetRows
Set rst = Nothing
With Me.ListBox4
.Clear
.ColumnCount = 3
.ColumnWidths = "310;30"
.List = Application.Transpose(pArray)
.ListIndex = -1
End With
'Place data in the listbox
With Me.ListBox5
.Clear
.ColumnCount = 2
.ColumnWidths = "310;30"
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
'Close ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
ElseIf ListBox1.ListIndex = 2 Then
'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT Predmet, id_predmet FROM 197 ORDER BY predmet;"
pSQL = "SELECT program, smer, id_vsi FROM znanstveni ORDER BY program, smer,
id_vsi;"
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows
rst.Close
rst.Open pSQL, cnt
pArray = rst.GetRows
With Me.ListBox4
.Clear
.BoundColumn = 3
.ColumnCount = 3
.ColumnWidths = "150;150;30"
.List = Application.Transpose(pArray)
.ListIndex = -1
End With
'Place data in the listbox
With Me.ListBox5
.Clear
.ColumnCount = 3
.ColumnWidths = "310;30"
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
'Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
End If
End Sub
from mdb. I came so far with code which works for 1 and 2 columns, but i cant
make it work for 3 columns. it keeps reporting Type mismatch .List =
Application.Transpose(pArray)
Code:
Private Sub ListBox1_Click()
'Option Explicit
'Set reference to the Microsoft ActiveX Data Objects x.x Library!
'Global constants required
Const glob_sdbPath = "C:\ifran.mdb"
Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
glob_sdbPath & ";"
Dim rcArray As Variant
Dim pArray As Variant
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim pSQL As String
Dim sSQL As String
If ListBox1.ListIndex = 0 Then
'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT Predmet, id_predmet FROM 192 ORDER BY predmet;"
pSQL = "SELECT program, smer, id_vsi FROM stari ORDER BY program, id_vsi;"
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows
rst.Close
rst.Open pSQL, cnt
pArray = rst.GetRows
Set rst = Nothing
With Me.ListBox4
.Clear
.ColumnCount = 3
.ColumnWidths = "150;150;30"
.List = Application.Transpose(pArray)
.ListIndex = -1
End With
'Place data in the listbox
With Me.ListBox5
.Clear
.ColumnCount = 2
.ColumnWidths = "310;30"
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
'Close ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
ElseIf ListBox1.ListIndex = 1 Then
'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT Predmet, id_predmet FROM 196 ORDER BY predmet;"
pSQL = "SELECT program, id_vsi FROM prenovljeni ORDER BY program, id_vsi;"
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows
rst.Close
rst.Open pSQL, cnt
pArray = rst.GetRows
Set rst = Nothing
With Me.ListBox4
.Clear
.ColumnCount = 3
.ColumnWidths = "310;30"
.List = Application.Transpose(pArray)
.ListIndex = -1
End With
'Place data in the listbox
With Me.ListBox5
.Clear
.ColumnCount = 2
.ColumnWidths = "310;30"
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
'Close ADO objects
cnt.Close
Set rst = Nothing
Set cnt = Nothing
ElseIf ListBox1.ListIndex = 2 Then
'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT Predmet, id_predmet FROM 197 ORDER BY predmet;"
pSQL = "SELECT program, smer, id_vsi FROM znanstveni ORDER BY program, smer,
id_vsi;"
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows
rst.Close
rst.Open pSQL, cnt
pArray = rst.GetRows
With Me.ListBox4
.Clear
.BoundColumn = 3
.ColumnCount = 3
.ColumnWidths = "150;150;30"
.List = Application.Transpose(pArray)
.ListIndex = -1
End With
'Place data in the listbox
With Me.ListBox5
.Clear
.ColumnCount = 3
.ColumnWidths = "310;30"
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
'Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
End If
End Sub