By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,389 Members | 2,010 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,389 IT Pros & Developers. It's quick & easy.

changing recordsource of a form

P: n/a
Hi.

I have a form which has as its recordsource an SQL string. The SQL
String is as follows: SELECT * from CONTACTS where false.

this ensures that there is no data loaded in the form when the form is
opened. After the user selects the contact from an unbound combobox I
want the form to be rebound to its recordsource.

I tried using form.recordsource = "Contacts" in the afterupdate event of
the Combobox but I still have no data showing. I also tried to requery
after setting the recordsource but no luck.

In a module I also have a function which, if the form is in browse mode
locks any unbound controls but it does not or should not affect bound
controls.

here is the function:

'this function determines whether the control on the form is bound or
unbound
'if the control is unbound (i.e. does not have a control source
property) then the control
'is locked if the form is in browse mode.

Public Function LockControlsForBrowse(frmBrowse As Form) As Boolean

LockControlsForBrowse = False

Dim ctl As Control
Dim prp As Property
Dim ctlCount As Integer, UnboundCtls As Integer

' On Error GoTo props_err

ctlCount = 0
UnboundCtls = 0

For Each ctl In frmBrowse.Controls
'Debug.Print ctl.Properties("Name")
For Each prp In ctl.Properties
' Print name of each property.
If prp.Name = "ControlSource" Then
'Debug.Print prp.Name; " = "; prp.Value
If prp.Value = "" Then
'UnboundCtls = UnboundCtls + 1
Else 'Lock the control for browse!!
ctl.Properties("Locked") = True
End If
End If

Next prp

'ctlCount = ctlCount + 1
Next ctl
'FormattedMsgBox "Number of controls on the form = " & Str(ctlCount)
& vbCrLf & vbCrLf & "Number of Unbound controls = " & Str(UnboundCtls)
'Debug.Print ctlCount
'Debug.Print UnboundCtls
LockControlsForBrowse = True
props_exit:
Set ctl = Nothing
Set prp = Nothing
Exit Function

props_err:
If Err = 2187 Then

Debug.Print vbTab & prp.Name & " = Only available at design
time."
Resume Next

Else

Debug.Print vbTab & prp.Name & " = Error Occurred: " &
Err.Description
Resume Next

End If
End Function
and here is all the code from behind the form. I think the problem is in
the last event procedure which is cbxSelectContact_AfterUpdate:

Option Explicit
Option Compare Database
Dim streditmode As String
Dim cbxeventyear As Object
Dim resp As Integer

Private Sub cbxEventName_AfterUpdate()
cbxeventyear.Requery
End Sub

Private Sub cbxSelectCountry_AfterUpdate()
Dim provstate As String, strSQL As String
Select Case cbxSelectCountry.Text
Case "Canada"
provstate = "Province"
strSQL = "SELECT [State and Province List].[State/ProvinceName],
[State and Province List].[State or Province] "
strSQL = strSQL & " FROM [State and Province List]"
strSQL = strSQL & " WHERE [State and Province List].[State or
Province] = '" & provstate & "'"
strSQL = strSQL & " ORDER BY [State and Province
List].[State/ProvinceName] "
cbxProvince.RowSource = strSQL
cbxProvince.Requery
cbxProvince.Value = "Ontario"
Case "United States"
provstate = "State"
strSQL = "SELECT [State and Province List].[State/ProvinceName],
[State and Province List].[State or Province] "
strSQL = strSQL & " FROM [State and Province List]"
strSQL = strSQL & " WHERE [State and Province List].[State or
Province] = '" & provstate & "'"
strSQL = strSQL & " ORDER BY [State and Province
List].[State/ProvinceName] "
cbxProvince.RowSource = strSQL
cbxProvince.Requery
cbxProvince.Value = ""
txtCity.Value = ""
Case Else
provstate = "Other"
cbxProvince.RowSource = ""
cbxProvince.Requery
cbxProvince.Value = ""
txtCity.Value = ""

End Select
End Sub

Private Sub cmdExit_Click()
Dim streditmode As String
If streditmode = "" Then
streditmode = Me.OpenArgs
Select Case streditmode
Case "A" 'Add Mode
resp = FormattedMsgBox("Do you want to add another
contact?", vbQuestion + vbYesNo, "Add another contact?")
Case "B" 'Browse Mode
resp = FormattedMsgBox("Do you want to browse some more
contacts?", vbQuestion + vbYesNo, "Keep Browsing?")
Case "E" 'Edit Mode
resp = FormattedMsgBox("Do you want to edit another
contact?", vbQuestion + vbYesNo, "Edit another contact?")
End Select
End If
If resp = vbYes Then
If streditmode = "B" Then
cbxSelectContact.SetFocus
End If
Else
DoCmd.Close
DoCmd.OpenForm "Main Form", acNormal, , , , acDialog
End If
End Sub

Private Sub Event_Name_Click()
DoCmd.OpenForm "Events Form"
End Sub

Private Sub cmdImportContacts_Click()
On Error GoTo Err_cmdImportContacts_Click
DoCmd.DoMenuItem acFormBar, acFile, 2, 0, acMenuVer70

Exit_cmdImportContacts_Click:
Exit Sub

Err_cmdImportContacts_Click:
If Err.Number <> 2501 Then MsgBox Err.Description
Resume Exit_cmdImportContacts_Click
End Sub

Private Sub Form_Current()
LstContactProducts.Requery
txtProductDescription.SetFocus
If LstContactProducts.ListCount = 0 Then
txtProductDescription.Value = ""
CbxSalutation.SetFocus
End If
End Sub

Private Sub Form_Open(Cancel As Integer)

Dim strSQL As String

strSQL = "select * from Contacts where False"

Form.RecordSource = strSQL

streditmode = ""
If Not IsNull(Me.OpenArgs) Then
streditmode = Me.OpenArgs
Else
DoCmd.CancelEvent 'Cancel opening of the form and give the user an
error message
FormattedMsgBox "Error - Open Mode not passed to form. This form
must be opened through code. @Please report this error to the Program
Administrator@", vbCritical, "Error"
End If

If UCase(streditmode) = "B" Then 'Browse mode, so lock the appropriate
controls!

If Not LockControlsForBrowse(Me) Then
DoCmd.CancelEvent 'Don't continue to open the form!
FormattedMsgBox "An error occured while setting up this form
for Browse Mode. @Please report this error to the Program
Administrator@", vbCritical, "Error"
End If
End If

If streditmode = "A" Then
CbxSalutation.SetFocus
cbxSelectContact.Visible = False
Box94.Visible = False
cmdImportContacts.Left = 0.079
'cbxFilterbyEvent.Visible = False
ElseIf streditmode = "E" Or streditmode = "B" Then
cmdImportContacts.Visible = False
cbxSelectContact.Visible = True
Box94.Visible = True
cbxSelectContact.SetFocus

End If
End Sub

Private Sub LstContactProducts_AfterUpdate()
txtProductDescription.SetFocus
txtProductDescription.Value = LstContactProducts.Column(3,
LstContactProducts.ItemsSelected)
LstContactProducts.SetFocus
End Sub

Private Sub LstContactProducts_KeyDown(KeyCode As Integer, Shift As
Integer)

Dim strSQL As String
Dim varitem As Variant
Dim strContactID As String, strProdToDelete As String, resp As Integer,
PromptStr As String

Select Case KeyCode
Case 45 'Insert Key
If Not IsNull(ContactID.Value) Then
DoCmd.OpenForm "Add Products to Contacts Form", acNormal, ,
, , acDialog, ContactID.Value
LstContactProducts.Requery
End If
Case 46 'Delete Key
'If the user presses the delete key, then ask them if they
are sure
'If they are, then delete the product from the contact

If LstContactProducts.ItemsSelected.Count > 0 Then
PromptStr = "Are you sure you want to delete the
selected products for " & FirstName.Value & " " & LastName.Value & "?"
resp = FormattedMsgBox(PromptStr, vbInformation +
vbYesNoCancel, "Warning!")
If resp = vbYes Then
strContactID = ContactID.Value
For Each varitem In LstContactProducts.ItemsSelected
strProdToDelete = LstContactProducts.Column(1,
varitem)
strSQL = "DELETE * "
strSQL = strSQL & " FROM [Add Products to
Contacts Table]"
strSQL = strSQL & " WHERE ([Add Products to
Contacts Table].ContactID= " & strContactID & ""
strSQL = strSQL & " AND [Add Products to
Contacts Table].ProductID = " & strProdToDelete & ");"
'Delete the Product
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
LstContactProducts.Requery
txtProductDescription.Requery
Next varitem
End If
Else 'User pressed delete key without selecting a product to
delete
FormattedMsgBox "You pressed the Delete Key but did not
select a product to Delete!" & vbCrLf & vbCrLf & "Nothing will be
deleted", vbInformation, "Notice"
End If
End Select
End Sub

Private Sub txtPosition_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 45 'Insert Key
DoCmd.OpenForm "Add New Position Form", acNormal, , , acFormAdd,
acDialog
End Select
End Sub

Private Sub cbxSelectContact_AfterUpdate()
Me.RecordSource = "Contacts"
'Bind the form to the contacts table and then find the record in the
table that matches the control and display it in the form.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[ContactID] = " & Str(Nz(Me![cbxSelectContact],
0))
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 12 '05 #1
Share this Question
Share on Google+
2 Replies


P: n/a
Setting the form recordsource to "Contacts" will work if you include a line
after that - Me.Refresh
Form data does not automatically refresh when the recordsource is changed,
so you have to do it expressly.

Mike Storr
www.veraccess.com
"ColinWard" <je*********@hotmail.com> wrote in message
news:40***********************@news.frii.net...
Hi.

I have a form which has as its recordsource an SQL string. The SQL
String is as follows: SELECT * from CONTACTS where false.

this ensures that there is no data loaded in the form when the form is
opened. After the user selects the contact from an unbound combobox I
want the form to be rebound to its recordsource.

I tried using form.recordsource = "Contacts" in the afterupdate event of
the Combobox but I still have no data showing. I also tried to requery
after setting the recordsource but no luck.

In a module I also have a function which, if the form is in browse mode
locks any unbound controls but it does not or should not affect bound
controls.

here is the function:

'this function determines whether the control on the form is bound or
unbound
'if the control is unbound (i.e. does not have a control source
property) then the control
'is locked if the form is in browse mode.

Public Function LockControlsForBrowse(frmBrowse As Form) As Boolean

LockControlsForBrowse = False

Dim ctl As Control
Dim prp As Property
Dim ctlCount As Integer, UnboundCtls As Integer

' On Error GoTo props_err

ctlCount = 0
UnboundCtls = 0

For Each ctl In frmBrowse.Controls
'Debug.Print ctl.Properties("Name")
For Each prp In ctl.Properties
' Print name of each property.
If prp.Name = "ControlSource" Then
'Debug.Print prp.Name; " = "; prp.Value
If prp.Value = "" Then
'UnboundCtls = UnboundCtls + 1
Else 'Lock the control for browse!!
ctl.Properties("Locked") = True
End If
End If

Next prp

'ctlCount = ctlCount + 1
Next ctl
'FormattedMsgBox "Number of controls on the form = " & Str(ctlCount)
& vbCrLf & vbCrLf & "Number of Unbound controls = " & Str(UnboundCtls)
'Debug.Print ctlCount
'Debug.Print UnboundCtls
LockControlsForBrowse = True
props_exit:
Set ctl = Nothing
Set prp = Nothing
Exit Function

props_err:
If Err = 2187 Then

Debug.Print vbTab & prp.Name & " = Only available at design
time."
Resume Next

Else

Debug.Print vbTab & prp.Name & " = Error Occurred: " &
Err.Description
Resume Next

End If
End Function
and here is all the code from behind the form. I think the problem is in
the last event procedure which is cbxSelectContact_AfterUpdate:

Option Explicit
Option Compare Database
Dim streditmode As String
Dim cbxeventyear As Object
Dim resp As Integer

Private Sub cbxEventName_AfterUpdate()
cbxeventyear.Requery
End Sub

Private Sub cbxSelectCountry_AfterUpdate()
Dim provstate As String, strSQL As String
Select Case cbxSelectCountry.Text
Case "Canada"
provstate = "Province"
strSQL = "SELECT [State and Province List].[State/ProvinceName],
[State and Province List].[State or Province] "
strSQL = strSQL & " FROM [State and Province List]"
strSQL = strSQL & " WHERE [State and Province List].[State or
Province] = '" & provstate & "'"
strSQL = strSQL & " ORDER BY [State and Province
List].[State/ProvinceName] "
cbxProvince.RowSource = strSQL
cbxProvince.Requery
cbxProvince.Value = "Ontario"
Case "United States"
provstate = "State"
strSQL = "SELECT [State and Province List].[State/ProvinceName],
[State and Province List].[State or Province] "
strSQL = strSQL & " FROM [State and Province List]"
strSQL = strSQL & " WHERE [State and Province List].[State or
Province] = '" & provstate & "'"
strSQL = strSQL & " ORDER BY [State and Province
List].[State/ProvinceName] "
cbxProvince.RowSource = strSQL
cbxProvince.Requery
cbxProvince.Value = ""
txtCity.Value = ""
Case Else
provstate = "Other"
cbxProvince.RowSource = ""
cbxProvince.Requery
cbxProvince.Value = ""
txtCity.Value = ""

End Select
End Sub

Private Sub cmdExit_Click()
Dim streditmode As String
If streditmode = "" Then
streditmode = Me.OpenArgs
Select Case streditmode
Case "A" 'Add Mode
resp = FormattedMsgBox("Do you want to add another
contact?", vbQuestion + vbYesNo, "Add another contact?")
Case "B" 'Browse Mode
resp = FormattedMsgBox("Do you want to browse some more
contacts?", vbQuestion + vbYesNo, "Keep Browsing?")
Case "E" 'Edit Mode
resp = FormattedMsgBox("Do you want to edit another
contact?", vbQuestion + vbYesNo, "Edit another contact?")
End Select
End If
If resp = vbYes Then
If streditmode = "B" Then
cbxSelectContact.SetFocus
End If
Else
DoCmd.Close
DoCmd.OpenForm "Main Form", acNormal, , , , acDialog
End If
End Sub

Private Sub Event_Name_Click()
DoCmd.OpenForm "Events Form"
End Sub

Private Sub cmdImportContacts_Click()
On Error GoTo Err_cmdImportContacts_Click
DoCmd.DoMenuItem acFormBar, acFile, 2, 0, acMenuVer70

Exit_cmdImportContacts_Click:
Exit Sub

Err_cmdImportContacts_Click:
If Err.Number <> 2501 Then MsgBox Err.Description
Resume Exit_cmdImportContacts_Click
End Sub

Private Sub Form_Current()
LstContactProducts.Requery
txtProductDescription.SetFocus
If LstContactProducts.ListCount = 0 Then
txtProductDescription.Value = ""
CbxSalutation.SetFocus
End If
End Sub

Private Sub Form_Open(Cancel As Integer)

Dim strSQL As String

strSQL = "select * from Contacts where False"

Form.RecordSource = strSQL

streditmode = ""
If Not IsNull(Me.OpenArgs) Then
streditmode = Me.OpenArgs
Else
DoCmd.CancelEvent 'Cancel opening of the form and give the user an
error message
FormattedMsgBox "Error - Open Mode not passed to form. This form
must be opened through code. @Please report this error to the Program
Administrator@", vbCritical, "Error"
End If

If UCase(streditmode) = "B" Then 'Browse mode, so lock the appropriate
controls!

If Not LockControlsForBrowse(Me) Then
DoCmd.CancelEvent 'Don't continue to open the form!
FormattedMsgBox "An error occured while setting up this form
for Browse Mode. @Please report this error to the Program
Administrator@", vbCritical, "Error"
End If
End If

If streditmode = "A" Then
CbxSalutation.SetFocus
cbxSelectContact.Visible = False
Box94.Visible = False
cmdImportContacts.Left = 0.079
'cbxFilterbyEvent.Visible = False
ElseIf streditmode = "E" Or streditmode = "B" Then
cmdImportContacts.Visible = False
cbxSelectContact.Visible = True
Box94.Visible = True
cbxSelectContact.SetFocus

End If
End Sub

Private Sub LstContactProducts_AfterUpdate()
txtProductDescription.SetFocus
txtProductDescription.Value = LstContactProducts.Column(3,
LstContactProducts.ItemsSelected)
LstContactProducts.SetFocus
End Sub

Private Sub LstContactProducts_KeyDown(KeyCode As Integer, Shift As
Integer)

Dim strSQL As String
Dim varitem As Variant
Dim strContactID As String, strProdToDelete As String, resp As Integer,
PromptStr As String

Select Case KeyCode
Case 45 'Insert Key
If Not IsNull(ContactID.Value) Then
DoCmd.OpenForm "Add Products to Contacts Form", acNormal, ,
, , acDialog, ContactID.Value
LstContactProducts.Requery
End If
Case 46 'Delete Key
'If the user presses the delete key, then ask them if they
are sure
'If they are, then delete the product from the contact

If LstContactProducts.ItemsSelected.Count > 0 Then
PromptStr = "Are you sure you want to delete the
selected products for " & FirstName.Value & " " & LastName.Value & "?"
resp = FormattedMsgBox(PromptStr, vbInformation +
vbYesNoCancel, "Warning!")
If resp = vbYes Then
strContactID = ContactID.Value
For Each varitem In LstContactProducts.ItemsSelected
strProdToDelete = LstContactProducts.Column(1,
varitem)
strSQL = "DELETE * "
strSQL = strSQL & " FROM [Add Products to
Contacts Table]"
strSQL = strSQL & " WHERE ([Add Products to
Contacts Table].ContactID= " & strContactID & ""
strSQL = strSQL & " AND [Add Products to
Contacts Table].ProductID = " & strProdToDelete & ");"
'Delete the Product
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
LstContactProducts.Requery
txtProductDescription.Requery
Next varitem
End If
Else 'User pressed delete key without selecting a product to
delete
FormattedMsgBox "You pressed the Delete Key but did not
select a product to Delete!" & vbCrLf & vbCrLf & "Nothing will be
deleted", vbInformation, "Notice"
End If
End Select
End Sub

Private Sub txtPosition_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case 45 'Insert Key
DoCmd.OpenForm "Add New Position Form", acNormal, , , acFormAdd,
acDialog
End Select
End Sub

Private Sub cbxSelectContact_AfterUpdate()
Me.RecordSource = "Contacts"
'Bind the form to the contacts table and then find the record in the
table that matches the control and display it in the form.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[ContactID] = " & Str(Nz(Me![cbxSelectContact],
0))
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Nov 12 '05 #2

P: n/a
Hi.

I figured it out. somehow the Data Entry Property of the form was set to
"yes" I set it to No and everything works.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
Nov 12 '05 #3

This discussion thread is closed

Replies have been disabled for this discussion.