Access SubForm selection depends on Combo box - vba

I would like to Filter my sub form based on my Combo box filter. I'm getting code error. I need help with this.
After Update I have written one event:
Private Sub cboSelected_AfterUpdate()
Dim MyName As String
MyName = " select * from [ITP_Checklist Log] where ([ITP_Checklist Log].[Name] = " & Me.cboSelected & " )"
Me.ITP_Checklist_Log_subform.Form.RecordSource = MyName
Me.ITP_Checklist_Log_subform.Form.Requery
End Sub
Error:
Run-time error '3464'
Data Type Mismatch in Criteria expression.

Use quotes for string values - and Requery is only needed if you don't change the recordsource:
Private Sub cboSelected_AfterUpdate()
Dim MyName As String
MyName = "select * from [ITP_Checklist Log] where ([ITP_Checklist Log].[Name] = '" & Me!cboSelected.Value & "')"
Debug.Print MyName
If Me!ITP_Checklist_Log_subform.Form.RecordSource = MyName Then
Me!ITP_Checklist_Log_subform.Form.Requery
Else
Me!ITP_Checklist_Log_subform.Form.RecordSource = MyName
End If
End Sub

Related

Data Type Mismatch on SQL statement

I am trying to pull in column data from a table into a timer in VBA. In my table I have IntervalSeconds as a number. I'm trying to query the number of seconds to determine how long to set my counter for.
Dim timeRemaining As Long (Form Variable) - used in multiple functionss
Private Sub Form_Open(Cancel As Integer)
Dim strSQL As String
Me.Visible = False
strSQL = "SELECT AccessControl.IntervalSeconds FROM AccessControl WHERE AccessControl.DatabaseName = '" & CurrentDb.Name & "'"
timeRemaining = CLng(strSQL)
DoCmd.OpenForm ("frmForceLogout")
End Sub
Every time I run the form I get a Type Mismatch error when I hit the timeRemaining = cLng(strSQL) line. Am I missing something?
You can use DLookup for such simple tasks:
Private Sub Form_Open(Cancel As Integer)
Dim Criteria As String
Me.Visible = False
Criteria = "DatabaseName = '" & CurrentDb.Name & "'"
timeRemaining = DLookup("IntervalSeconds", "AccessControl", Criteria)
DoCmd.OpenForm ("frmForceLogout")
End Sub

How to use this VBA code to use as Public Subroutine in Access VBA

I have got this code below that restricts users to leave an empty field in a form. Now I want to use this in all of my forms. I've tried to use in Public Subroutine using a module. But it doesn't work.
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim msg As String, Style As Integer, Title As String
Dim nl As String, ctl As Control
nl = vbNewLine & vbNewLine
For Each ctl In Me.Controls
If ctl.ControlType = acTextBox Then
If ctl.Tag = "*" And Trim(ctl & "") = "" Then
msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
"You can't save this record until this data is provided!" & nl & _
"Enter the data and try again . . . "
Style = vbCritical + vbOKOnly
Title = "Required Data..."
MsgBox msg, Style, Title
ctl.SetFocus
Cancel = True
Exit For
End If
End If
Next
End Sub
I just want to use this in all of my forms. How do I accomplish this?
Good question, and good idea.
So, keep in mind that "me" is just the current form you are working with.
So, create a plane jane standard code module. And drop in your function like this with a "few" changes.
Public Function CheckRequired(MyMe As Form) As Boolean
Dim msg As String
Dim Style As Integer
Dim Title As String
Dim nl As String
Dim ctl As Control
nl = vbCrLf ' crlf gives you one line
CheckRequired = False ' assume everything ok
For Each ctl In MyMe.Controls
If ctl.ControlType = acTextBox Then
If ctl.Tag = "*" And Trim(ctl & "") = "" Then
msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
"You can't save this record until this data is provided!" & nl & _
"Enter the data and try again . . . "
Style = vbCritical + vbOKOnly
Title = "Required Data..."
MsgBox msg, Style, Title
ctl.SetFocus
CheckRequired = True
Exit Function
End If
End If
Next
End Function
Now, in the forms event (which has that cancel), then you do this:
Private Sub Form_BeforeUpdate(Cancel As Integer)
Cancel = CheckRequired(Me)
End Sub
As #June7 mentioned, Me is only valid behind forms and reports. It is shorthand alias for the form/report name/object. To achieve what you are looking for, you can try this concept. Create the global routine like below :
Public Function Validate_BeforeUpdate(frm As Form) As Integer
Dim msg As String, Style As Integer, Title As String
Dim nl As String, ctl As Control
nl = vbNewLine & vbNewLine
For Each ctl In frm.Controls
'''' your other code
Validate_BeforeUpdate = 1
Exit For
Next
End Sub
And to use this from your other forms, do it like below :
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Validate_BeforeUpdate(Me) = 1 Then
Cancel = True
End If
End Sub
This is not a tested code, if you follow this idea, you should be okay to have what you are trying to do.

Why I Cant set the FilterOn property in form_open?

I try to set a filter of an continuous form in access vba. This is the code I use:
Private Sub Form_Open(Cancel As Integer)
Dim filter As String
filter = "1 = 0" ' "1=0" is just for testing purpurses
Me.filter = filter
Me.FilterOn = True
Debug.Print Me.FilterOn & "; " & Me.filter
end sub
The output is:
False; 1 = 0
and the filter is not used.
Why does this not work? And is there a way to set and activate the filter before the form is shown?
I found out that the reason is. I use a framework where I set the recordsource later. While there is no recordsource, "Me.FilterOn = True" simply does not work. The following code does work:
Private Sub Form_Open(Cancel As Integer)
Me.RecordSource = "select * from MyTable"
Dim filter As String
filter = "1 = 0" ' "1=0" is just for testing purpurses
Me.filter = filter
Me.FilterOn = True
Debug.Print Me.FilterOn & "; " & Me.filter
end sub
and the output is:
True; 1 = 0

Modify multiple records via listbox based on combobox in Access

I have a form that has a multi-selection listbox based on a query of items that have a specific field that is blank (UserID). I would like to select a UserID from a combobox and click a button to have all selected records modified to have that UserID. (I would also like to update the DateAssigned field to whatever the current date is). CaseID is the unique value in the table.
Sample Form Picture
(The combo box has two columns, the second one has the actual ID I'd want to use).
I've looked at multiple different posts on here like this but I haven't been able to get it to work. Here's an example of a code I found and tried, altered slightly.
Private Sub AssignButton_Click()
Dim lCnt As Long
Dim lID As Long
Dim sSQL_Update As String
Dim sText_1 As String
Dim bSuccess As Boolean
sText_1 = Me.ComboBox
With Me.ToAssignList
For lCnt = 1 To .ListCount
If .Selected(lCnt) Then
lID = .Column(4, lCnt - 1)
'Example update for 1 column
sSQL_Update = "UPDATE MainData SET UserID = '" & sText_1 & "' WHERE CaseID = " & lID & ";"
bSuccess = Update_Statement(sSQL_Update)
End If
Next
End With
End Sub
Public Function Update_Statement(sUpdate_Stmt) As Boolean
Dim db As Database
Set db = CurrentDb
db.Execute (sUpdate_Stmt)
End Function
When I try running this nothing happens.
Thank you!
Hy, Some remarks and tweaks to your code :
First enable the direct screen :
This will enable you to use the debug function.
Is the field : UserID in the table Maindata a text field ? If so, fine, otherwise you should alter the string to :
"UPDATE MainData SET UserID = " & Cint(sText_1) & " WHERE CaseID = " & lID & ";"
Then it would be better to create different functions in a module for what you are trying to do. But ok, this is not your main concern right now...
Try :
Private Sub AssignButton_Click()
Dim lCnt As Long
Dim lID As Long
Dim sSQL_Update As String
Dim sText_1 As String
Dim bSuccess As Boolean
sText_1 = Me.ComboBox
With Me.ToAssignList
For lCnt = 1 To .ListCount
If .Selected(lCnt) Then
lID = .Column(4, lCnt - 1)
'Example update for 1 column
sSQL_Update = "UPDATE MainData SET UserID = '" & sText_1 & "' WHERE CaseID = " & lID & ";"
'
'Check your sql statement and add it to stack overflow if it still is not working
'
Debug.Print sSQL_Update
'
bSuccess = Update_Statement(sSQL_Update)
End If
Next
End With
End Sub
There is should be a logical check in the code bellow to see if the update is done, anyhow, the code bellow should work and return a true value if the update doesn't produce an error... it's not good code but ok.
Public Function Update_Statement(sUpdate_Stmt) As Boolean
Dim Currentdb As Database
Set Currentdb = Currentdb
Call Currentdb.Execute(sUpdate_Stmt, dbSeeChanges)
Update_Statement = True
End Function
Good luck !

Save reports according to choice from a sub form

I have a main form called (frmcarSearch) that displays table data called (tblCar).
The form contains three drop-down menu (cmbCar, cmbType, cmbGroup) that allow user to filter data and display them in a sub-form called (frmCarSub)
and there are three buttons to save the filtered data btnPrint, btnPDF, btnExcel.
The question is: How to write a code for each button so that the report displays (or save) the data in the sub-form according to the choice from each drop-down menu?
The code for each combo box:
Private Sub cmbCar_AfterUpdate()
Me.cmbGroup.Value = ""
Me.cmbType.Value = ""
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = "[CarNum]= '" & [cmbCar] & "'"
Me.frmCarSub.Form.FilterOn = True
End Sub
Private Sub cmbType_AfterUpdate()
Me.cmbGroup.Value = ""
Me.cmbCar.Value = ""
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = "[TypeName]='" & [cmbType] & "'"
Me.frmCarSub.Form.FilterOn = True
End Sub
Private Sub cmbGroup_AfterUpdate()
Me.cmbCar.Value = ""
Me.cmbType.Value = ""
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = "[CarGroupName]= '" & [cmbGroup] & "'"
Me.frmCarSub.Form.FilterOn = True
End Sub
I used this code for btnPrint button
Private Sub btnPrint_Click()
If IsNull([cmbCar]) Then
DoCmd.OpenReport "rptCar", acViewPreview
Else
DoCmd.OpenReport "rptCar", acViewPreview, , "[CarNum]='" & [cmbCar] & "'"
End If
End Sub
But the problem with this code is that I have to use three buttons for the three menus and this is illogical.
Thank you.
You could define a function such as the following with the module for your form:
Function FilterString() As String
If Not IsNull(cmbCar) Then FilterString = " AND [CarNum]= '" & cmbCar & "'"
If Not IsNull(cmbType) Then FilterString = FilterString & " AND [TypeName]= '" & cmbType & "'"
If Not IsNull(cmbGroup) Then FilterString = FilterString & " AND [CarGroupName]= '" & cmbGroup & "'"
FilterString = Mid(FilterString, 6)
End Function
Then, define another function such as:
Function SetFilter()
Me.frmCarSub.SetFocus
Me.frmCarSub.Form.Filter = FilterString
Me.frmCarSub.Form.FilterOn = True
End Function
Then, the event handlers for each of your comboboxes become:
Private Sub cmbCar_AfterUpdate()
SetFilter
End Sub
Private Sub cmbType_AfterUpdate()
SetFilter
End Sub
Private Sub cmbGroup_AfterUpdate()
SetFilter
End Sub
Finally, the Print button event handler can become:
Private Sub btnPrint_Click()
If FilterString = vbNullString Then
DoCmd.OpenReport "rptCar", acViewPreview
Else
DoCmd.OpenReport "rptCar", acViewPreview, , FilterString
End If
End Sub
And the user also has the ability to filter by more than one field.