View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
[email protected] Gmspences10@googlemail.com is offline
external usenet poster
 
Posts: 7
Default Populate Userform Listbox with Access values

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