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.recordsour ce = "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 LockControlsFor Browse(frmBrows e As Form) As Boolean
LockControlsFor Browse = 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.Contr ols
'Debug.Print ctl.Properties( "Name")
For Each prp In ctl.Properties
' Print name of each property.
If prp.Name = "ControlSou rce" 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
'FormattedMsgBo x "Number of controls on the form = " & Str(ctlCount)
& vbCrLf & vbCrLf & "Number of Unbound controls = " & Str(UnboundCtls )
'Debug.Print ctlCount
'Debug.Print UnboundCtls
LockControlsFor Browse = 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 cbxSelectContac t_AfterUpdate:
Option Explicit
Option Compare Database
Dim streditmode As String
Dim cbxeventyear As Object
Dim resp As Integer
Private Sub cbxEventName_Af terUpdate()
cbxeventyear.Re query
End Sub
Private Sub cbxSelectCountr y_AfterUpdate()
Dim provstate As String, strSQL As String
Select Case cbxSelectCountr y.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.Row Source = strSQL
cbxProvince.Req uery
cbxProvince.Val ue = "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.Row Source = strSQL
cbxProvince.Req uery
cbxProvince.Val ue = ""
txtCity.Value = ""
Case Else
provstate = "Other"
cbxProvince.Row Source = ""
cbxProvince.Req uery
cbxProvince.Val ue = ""
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
cbxSelectContac t.SetFocus
End If
Else
DoCmd.Close
DoCmd.OpenForm "Main Form", acNormal, , , , acDialog
End If
End Sub
Private Sub Event_Name_Clic k()
DoCmd.OpenForm "Events Form"
End Sub
Private Sub cmdImportContac ts_Click()
On Error GoTo Err_cmdImportCo ntacts_Click
DoCmd.DoMenuIte m acFormBar, acFile, 2, 0, acMenuVer70
Exit_cmdImportC ontacts_Click:
Exit Sub
Err_cmdImportCo ntacts_Click:
If Err.Number <> 2501 Then MsgBox Err.Description
Resume Exit_cmdImportC ontacts_Click
End Sub
Private Sub Form_Current()
LstContactProdu cts.Requery
txtProductDescr iption.SetFocus
If LstContactProdu cts.ListCount = 0 Then
txtProductDescr iption.Value = ""
CbxSalutation.S etFocus
End If
End Sub
Private Sub Form_Open(Cance l As Integer)
Dim strSQL As String
strSQL = "select * from Contacts where False"
Form.RecordSour ce = strSQL
streditmode = ""
If Not IsNull(Me.OpenA rgs) Then
streditmode = Me.OpenArgs
Else
DoCmd.CancelEve nt '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(streditmo de) = "B" Then 'Browse mode, so lock the appropriate
controls!
If Not LockControlsFor Browse(Me) Then
DoCmd.CancelEve nt '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.S etFocus
cbxSelectContac t.Visible = False
Box94.Visible = False
cmdImportContac ts.Left = 0.079
'cbxFilterbyEve nt.Visible = False
ElseIf streditmode = "E" Or streditmode = "B" Then
cmdImportContac ts.Visible = False
cbxSelectContac t.Visible = True
Box94.Visible = True
cbxSelectContac t.SetFocus
End If
End Sub
Private Sub LstContactProdu cts_AfterUpdate ()
txtProductDescr iption.SetFocus
txtProductDescr iption.Value = LstContactProdu cts.Column(3,
LstContactProdu cts.ItemsSelect ed)
LstContactProdu cts.SetFocus
End Sub
Private Sub LstContactProdu cts_KeyDown(Key Code 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(ContactI D.Value) Then
DoCmd.OpenForm "Add Products to Contacts Form", acNormal, ,
, , acDialog, ContactID.Value
LstContactProdu cts.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 LstContactProdu cts.ItemsSelect ed.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 LstContactProdu cts.ItemsSelect ed
strProdToDelete = LstContactProdu cts.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.SetWarnin gs False
DoCmd.RunSQL strSQL
DoCmd.SetWarnin gs True
LstContactProdu cts.Requery
txtProductDescr iption.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_Key Down(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 cbxSelectContac t_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.Cl one
rs.FindFirst "[ContactID] = " & Str(Nz(Me![cbxSelectContac t],
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!
