Populate Userform Listbox with Access values

[Gmspences10]

Hello Friends,

Can anyone help me with the below, I have a database which I am
connecting to via excel, rather than use the worksheets to display the
results I want to populate a form with two of the recordset's but I am
not getting anywhere.





Option Explicit
Public Sub retrieveCMInformation(searchCM As String)
Dim databaseName As String
Dim tableName As String
Dim db1 As Database
Dim Rs1 As Recordset
Dim queryString As String
Dim Dummy As Integer
Dim ResultsRowIndex As Integer

Dim retrievedDateOfEntry As String
Dim retrievedSalesTeam As String
Dim retrievedRelationshipManager As String
Dim retrievedCaseName As String
Dim retrievedSubject As String
Dim retrievedActionRequired As String
Dim retrievedReviewDate As String
Dim retrievedCM As String
Dim retrievedUpdateComments As String


' initialise variables
databaseName = ThisWorkbook.Path + "\CreditDiary1.mdb"
tableName = "CreditDiary"
queryString = ""
ResultsRowIndex = 1

' open the database
Set db1 = OpenDatabase(databaseName, , False) ' open for read only
access

' query the database to retrieve matching results
queryString = queryString + "SELECT CM"
queryString = queryString + " ,DateOfEntry"
queryString = queryString + " ,SalesTeam"
queryString = queryString + " ,RelationshipManager"
queryString = queryString + " ,CaseName"
queryString = queryString + " ,Subject"
queryString = queryString + " ,ActionRequired"
queryString = queryString + " ,ReviewDate"
queryString = queryString + " ,UpdateComments"
queryString = queryString + " FROM " + tableName
queryString = queryString + " WHERE CM = " + Chr$(34) + searchCM +
Chr$(34)
Set Rs1 = db1.OpenRecordset(queryString)

' if no results were found then warn the user and exit this
subroutine
If Rs1.RecordCount = 0 Then
Dummy = MsgBox("No diary entries for that Case Manager.", _
vbExclamation + vbOKOnly, _
"No Records Found")
GoTo endsub1
End If

' loop around all retrieved Case Manager data
Do While Rs1.EOF = False


' format retrieved data into variables
retrievedDateOfEntry = Rs1.Fields("DateOfEntry")
retrievedSalesTeam = Rs1.Fields("SalesTeam")
retrievedRelationshipManager = Rs1.Fields("RelationshipManager")
retrievedCaseName = Rs1.Fields("CaseName")
retrievedSubject = Rs1.Fields("Subject")
retrievedActionRequired = Rs1.Fields("ActionRequired")
retrievedReviewDate = Rs1.Fields("ReviewDate")
retrievedCM = Rs1.Fields("CM")
retrievedUpdateComments = Rs1.Fields("UpdateComments")

'format the retrieved data into the Results worksheet
With frmUserSelect.lstCaseRM
.BoundColumn = 1 ResultsRowIndex , 0 value =
retrievedCM

End With

'I can return the results from the database onto the worksheet
detailed below'

' With Worksheets("Results").Range("rStartingRow")
' .Offset(ResultsRowIndex, 0).Value = retrievedCM
' .Offset(ResultsRowIndex, 1).Value = retrievedDateOfEntry
' .Offset(ResultsRowIndex, 2).Value = retrievedSalesTeam
' .Offset(ResultsRowIndex, 3).Value =
retrievedRelationshipManager
' .Offset(ResultsRowIndex, 4).Value = retrievedCaseName
' .Offset(ResultsRowIndex, 5).Value = retrievedSubject
' .Offset(ResultsRowIndex, 6).Value =
retrievedActionRequired
' .Offset(ResultsRowIndex, 7).Value = retrievedReviewDate
' .Offset(ResultsRowIndex, 8).Value =
retrievedUpdateComments
' End With

' increment the index used to format rows into the Results
worksheet
ResultsRowIndex = ResultsRowIndex + 1

' retrieve next row from recordset
Rs1.MoveNext

' loop around all retrieved data
Loop

' activate the Results worksheet
Worksheets("Results").Select

endsub1:

' close the recordset
Rs1.Close

' close the database
db1.Close

Unload frmUserSelect

' tidy-up database objects
Set Rs1 = Nothing
Set db1 = Nothing

End Sub

 

[merjet]

What kind of control, e.g. ComboBox, do you want to use on the
UserForm to display the data from the Recordsets? There are additional
controls -- DBGrid, DBList, and DBCombo -- designed for such use.
However, they aren't easy to use and the Help for them isn't very
helpful.

Merjet

 

[merjet]

Sorry. I saw your subject line answered my question.

Merjet

 

[merjet]

Here is a working example.

Private Sub UserForm_Activate()
Dim db As Database
Dim rs As Recordset
Dim Sql As String

Set db = OpenDatabase("C:\temp\db1.mdb")
Sql = "SELECT * FROM Table1 WHERE " _
& "Name = " & Chr(34) & "Smith" & Chr(34)
Set rs = db.OpenRecordset(Sql)
With rs
If Not .BOF Then .MoveFirst
While Not .EOF
With ListBox1
.AddItem rs("Name")
.List(.ListCount - 1, 1) = rs("Age")
.List(.ListCount - 1, 2) = rs("SDate")
.List(.ListCount - 1, 3) = rs("Pay")
End With
.MoveNext
Wend
End With
Set rs = Nothing
db.Close
Set db = Nothing

End Sub

Hth,
Merjet

 

[Gmspences10]

Here is a working example.

Private Sub UserForm_Activate()
Dim db As Database
Dim rs As Recordset
Dim Sql As String

Set db = OpenDatabase("C:\temp\db1.mdb")
Sql = "SELECT * FROM Table1 WHERE " _
& "Name = " & Chr(34) & "Smith" & Chr(34)
Set rs = db.OpenRecordset(Sql)
With rs
If Not .BOF Then .MoveFirst
While Not .EOF
With ListBox1
.AddItem rs("Name")
.List(.ListCount - 1, 1) = rs("Age")
.List(.ListCount - 1, 2) = rs("SDate")
.List(.ListCount - 1, 3) = rs("Pay")
End With
.MoveNext
Wend
End With
Set rs = Nothing
db.Close
Set db = Nothing

End Sub

Hth,
Merjet

Thanks Merjet,

I have used

With rs
If Not .BOF Then .MoveFirst
While Not .EOF
With ListBox1
.AddItem rs("Name")
.List(.ListCount - 1, 1) = rs("Age")
.List(.ListCount - 1, 2) = rs("SDate")
.List(.ListCount - 1, 3) = rs("Pay")
End With
.MoveNext
Wend

works fine, i now need to be able to update the same recordset feilds
on a seperate userform, do you have any exampleas of this please??

 

[merjet]

works fine, i now need to be able to update the same recordset feilds

on a seperate userform, do you have any exampleas of this please??

The following code uses the same UserForm. With a seperate UserForm,
you would still need a control such as a ListBox to see what is in
Table1. I added 2 controls (CommandButton1 and TextBox1) that allow
changing the Age field in Table1. Note that most of the code supplied
earlier has been moved.

Hth,
Merjet

Private db As Database

Private Sub CommandButton1_Click()
Dim rs As Recordset
Dim bFound As Boolean

If TextBox1 <> "" And ListBox1.ListIndex > -1 Then
Set rs = db.OpenRecordset("Table1")
rs.MoveFirst
Do
With ListBox1
' if Table1 has primary key, need only
' check for match with primary field
If rs("Name") = .List(.ListIndex, 0) And _
rs("Age") = CInt(.List(.ListIndex, 1)) And _
rs("SDate") = CDate(.List(.ListIndex, 2)) And _
rs("Pay") = CInt(.List(.ListIndex, 3)) Then
rs.Edit
rs("Age") = CInt(TextBox1)
rs.Update
bFound = True
End If
End With
rs.MoveNext
Loop Until rs.EOF Or bFound = True
End If
Set rs = Nothing
FillListBox1
End Sub

Private Sub UserForm_Activate()
Set db = OpenDatabase("C:\temp\db1.mdb")
FillListBox1
End Sub

Private Sub UserForm_Deactivate()
db.Close
Set db = Nothing
End Sub

Private Sub FillListBox1()
Dim rs As Recordset
Dim Sql As String
Sql = "SELECT * FROM Table1 WHERE " _
& "Name = " & Chr(34) & "Smith" & Chr(34)
Set rs = db.OpenRecordset(Sql)
ListBox1.Clear
With rs
If Not .BOF Then .MoveFirst
While Not .EOF
With ListBox1
.AddItem rs("Name")
.List(.ListCount - 1, 1) = rs("Age")
.List(.ListCount - 1, 2) = rs("SDate")
.List(.ListCount - 1, 3) = rs("Pay")
End With
.MoveNext
Wend
End With
Me.Repaint
Set rs = Nothing
End Sub