Loading Data into a droplist using Access Database

  • Thread starter Thread starter Blue
  • Start date Start date
B

Blue

Hello,

I am trying to load data from an Access Database into a droplist...I found
the following code and changed the variable and the database location (which
doesn't seem to work or matbe I'm missing something):

Option Explicit
Dim txtCyberOther
Dim mobjchkOther
Dim chkOther
Dim cboCyber
Dim cboCyberProblem
Dim adoCyber

Function Item_Open()
Dim objInsp
Dim strCyber
Dim objPage

On Error Resume Next
strCyber = "C:\cyber.mdb"
Set adoCyber = OpenAccessDB(strCyber, "admin", "")

If Not adoCyber.State Is Nothing Then
Set objPage = _
Item.GetInspector.ModifiedFormPages("Message")
Set cboCyber = objPage.Controls("cboCyber")
Set cboCyberProblem = objPage.Controls("cboCyberProblem")
Call FillCyberList()
Call FillCyberProblemList()
End If

Set objInsp = Item.GetInspector
' set controls collection(s) and unbound text boxes
Set mobjchkOther = objInsp.ModifiedFormPages("Message").Controls
Set txtCyberOther = mobjchkOther("txtCyberOther")
Set chkOther = mobjchkOther("chkOther")
Set objInsp = Nothing

End Function

Function Item_Close()
On Error Resume Next
If adoCyber.State = adStateOpen Then
adoCyber.Close
End If
Set adoCyber = Nothing
Set cboCyber = Nothing
Set cboCyberProblem = Nothing
End Function

Sub FillCyberList()
Dim rstCybers
Dim strSQL
On Error Resume Next
Set rstCybers = CreateObject("ADODB.Recordset")
strSQL = "SELECT [Name]" & _
"from CyberAgents " & _
"ORDER BY [Name];"
rstCybers.Open strSQL, adoCyber, _
adOpenForwardOnly, adLockReadOnly
If rstCyber.State = adStateOpen Then
cboCyber.Column = rstCybers.GetRows
rstCybers.Close
End If
Set rstCybers = Nothing

End Sub

Sub FillCyberProblemList()
Dim rstCybersProblem
Dim strSQL
On Error Resume Next
Set rstCybersProblem = CreateObject("ADODB.Recordset")
strSQL = "SELECT [CyberProblems]" & _
"from Cyber Problems " & _
"ORDER BY [CyberProblems];"
rstCybersProblem.Open strSQL, adoCyber, _
adOpenForwardOnly, adLockReadOnly
If rstCybersProblem.State = adStateOpen Then
cboCyberProblem.Column = rstCybersProblem.GetRows
rstCybersProblem.Close
End If
Set rstCybersProblem = Nothing

End Sub

Function OpenAccessDB(strDBPath, UID, PWD)
Dim objADOConn
Dim strConn
On Error Resume Next
strConn = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & strDBPath & "; " & _
"User ID=" & UID & "; " & _
"Password=" & PWD & "; "
Set objADOConn = CreateObject("ADODB.Connection")
objADOConn.Open strConn
If (Err = 0) And (objADOConn.State = adStateOpen) Then
Set OpenAccessDB = objADOConn
Else
Set OpenAccessDB = Nothing
End If
Set objADOConn = Nothing

End Function

Sub chkOther_Click()
If mobjchkOther("chkOther").Value = True Then
mobjchkOther("txtCyberOther").Visible = True
End If
If mobjchkOther("chkOther").Value = False Then
mobjchkOther("txtCyberOther").Visible = False
End If

End Sub

Any help on this would be appreiaated...Thank you in advanced.

BLUE
 
I see you set two references to your ComboBox controls with cboCyberProblem and cboCyber. However, you never actually call the AddItem method for those controls. Loop through your recordset and add the appropriate data to the controls using that method.

--
Eric Legault - B.A, MCP, MCSD, Outlook MVP
--------------------------------------------------
Job: http://www.imaginets.com
Blog: http://blogs.officezealot.com/legault/



Blue said:
Hello,

I am trying to load data from an Access Database into a droplist...I found
the following code and changed the variable and the database location (which
doesn't seem to work or matbe I'm missing something):

Option Explicit
Dim txtCyberOther
Dim mobjchkOther
Dim chkOther
Dim cboCyber
Dim cboCyberProblem
Dim adoCyber

Function Item_Open()
Dim objInsp
Dim strCyber
Dim objPage

On Error Resume Next
strCyber = "C:\cyber.mdb"
Set adoCyber = OpenAccessDB(strCyber, "admin", "")

If Not adoCyber.State Is Nothing Then
Set objPage = _
Item.GetInspector.ModifiedFormPages("Message")
Set cboCyber = objPage.Controls("cboCyber")
Set cboCyberProblem = objPage.Controls("cboCyberProblem")
Call FillCyberList()
Call FillCyberProblemList()
End If

Set objInsp = Item.GetInspector
' set controls collection(s) and unbound text boxes
Set mobjchkOther = objInsp.ModifiedFormPages("Message").Controls
Set txtCyberOther = mobjchkOther("txtCyberOther")
Set chkOther = mobjchkOther("chkOther")
Set objInsp = Nothing

End Function

Function Item_Close()
On Error Resume Next
If adoCyber.State = adStateOpen Then
adoCyber.Close
End If
Set adoCyber = Nothing
Set cboCyber = Nothing
Set cboCyberProblem = Nothing
End Function

Sub FillCyberList()
Dim rstCybers
Dim strSQL
On Error Resume Next
Set rstCybers = CreateObject("ADODB.Recordset")
strSQL = "SELECT [Name]" & _
"from CyberAgents " & _
"ORDER BY [Name];"
rstCybers.Open strSQL, adoCyber, _
adOpenForwardOnly, adLockReadOnly
If rstCyber.State = adStateOpen Then
cboCyber.Column = rstCybers.GetRows
rstCybers.Close
End If
Set rstCybers = Nothing

End Sub

Sub FillCyberProblemList()
Dim rstCybersProblem
Dim strSQL
On Error Resume Next
Set rstCybersProblem = CreateObject("ADODB.Recordset")
strSQL = "SELECT [CyberProblems]" & _
"from Cyber Problems " & _
"ORDER BY [CyberProblems];"
rstCybersProblem.Open strSQL, adoCyber, _
adOpenForwardOnly, adLockReadOnly
If rstCybersProblem.State = adStateOpen Then
cboCyberProblem.Column = rstCybersProblem.GetRows
rstCybersProblem.Close
End If
Set rstCybersProblem = Nothing

End Sub

Function OpenAccessDB(strDBPath, UID, PWD)
Dim objADOConn
Dim strConn
On Error Resume Next
strConn = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=" & strDBPath & "; " & _
"User ID=" & UID & "; " & _
"Password=" & PWD & "; "
Set objADOConn = CreateObject("ADODB.Connection")
objADOConn.Open strConn
If (Err = 0) And (objADOConn.State = adStateOpen) Then
Set OpenAccessDB = objADOConn
Else
Set OpenAccessDB = Nothing
End If
Set objADOConn = Nothing

End Function

Sub chkOther_Click()
If mobjchkOther("chkOther").Value = True Then
mobjchkOther("txtCyberOther").Visible = True
End If
If mobjchkOther("chkOther").Value = False Then
mobjchkOther("txtCyberOther").Visible = False
End If

End Sub

Any help on this would be appreiaated...Thank you in advanced.

BLUE
Click to expand...
 
Back
Top