MS Access 2010 VBA runtime error 3075 (searching with apostrophes) - ms-access

The answer is probably really simple - I just can't come up with the right search term, I suspect.
I have a form that opens another form, displaying any employee record that matches the search as entered You can search by surname, given name, or employee ID (using separate buttons); it gives you a little message box if your search turns up nothing.
The code works fine, except for the usual problem with handling apostrophes in names ("O'Neill," "O'Brien," etc.) I found a really simple apostrophe handling function, but when I try to use the function in the search query it still throws up a 3075 runtime error, and I'm not sure why. It only throws up the runtime error with apostrophe-containing searches, so I feel like the function maybe isn't doing what I think it is.
I am happy to entertain solutions that involve "using this function but adding more quotation marks (or whatever)" as well as whole new ideas. I'd prefer to use something like this function, though, because it's so small and thus it'll be much faster and cleaner to replace the search-by-name code each place that it appears.
This is the code that works fine:
Private Sub btnSearchSurname_Click()
Dim frm As Form
Dim strSearch As String
strSearch = "[List_Employees.Surname] like '" & Me.EmpSurname & "*'"
strSearch = strSearch & " AND [CurrentEmployee] = " & True
DoCmd.OpenForm "Employee_Entry_Extended_Certs", , , strSearch, , acHidden
Set frm = Forms("Employee_Entry_Extended_Certs")
If frm.Recordset.RecordCount > 0 Then
frm.Visible = True
Else
MsgBox ("Employee not found. Try the 'all' button to see if they're inactive. If that doesn't work, please check for typos and try again.")
DoCmd.Close acForm, "Employee_Entry_Extended_Certs"
Call OpenPayrollCloseRest
End If
DoCmd.Close acForm, "Find_An_Employee"
I'm trying to use this simple public function to handle apostrophes:
Public Function adhHandleQuotes(ByVal varValue As Variant, Optional Delimiter As String = "'") As Variant
' Replace all instances of a string delimiter with TWO instances,
' thereby handling the darned quote issue once and for all. Also,
' surround the string with the delimiter, as well.
' Returns Null if the String was Null, otherwise
' returns the String with all instances of strDelimiter
' replaced with two of each.
adhHandleQuotes = strDelimiter & Replace(varValue, strDelimiter, strDelimiter & strDelimiter) & strDelimiter
End Function
I modified the search code to use the function by inserting three lines lines in place of the first "strSearch = " line:
Dim strSearch As String
Dim strTerm As String
strTerm = adhHandleQuotes(Me.EmpSurname)
strSearch = "[List_Employees.Surname] like '" & strTerm & "*'"
strSearch = strSearch & " AND [CurrentEmployee] = " & True
DoCmd.OpenForm "Employee_Entry_Extended_Certs", , , strSearch, , acHidden
And this is the runtime error dialogue box:

Why do you even need a function? Just simply incorporate a Double Quotes, my hack is to use Chr(34).
Private Sub btnSearchSurname_Click()
Dim frm As Form
Dim strSearch As String
strSearch = "[List_Employees.Surname] Like " & Chr(34) & Me.EmpSurname & "*" & Chr(34)
strSearch = strSearch & " AND [CurrentEmployee] = True"
DoCmd.OpenForm "Employee_Entry_Extended_Certs", , , strSearch, , acHidden
Set frm = Forms("Employee_Entry_Extended_Certs")
If frm.Recordset.RecordCount > 0 Then
frm.Visible = True
Else
MsgBox ("Employee not found. Try the 'all' button to see if they're inactive. If that doesn't work, please check for typos and try again.")
DoCmd.Close acForm, "Employee_Entry_Extended_Certs"
Call OpenPayrollCloseRest
End If
DoCmd.Close acForm, "Find_An_Employee"
End Sub

You might want to try this:
Access VBA, unescaped single quotes, Replace(), and null
Rather than doubling your apostrophe, it surrounds it with double quotes.

Related

Using OpenArgs to pass multiple textboxs into a different form

I am trying to pass 3 textboxes into a different form via parsing the string. I am getting a run time error 13.
Private Sub txtFullName_Click()
Const cstrForm As String = "frmInputInfo"
DoCmd.OpenForm "frmInputInfo", acFormAdd, , , acDialog, _
Me.txtFullName & "|" & Me.PATS_Job_Opening_ID & "|" & Me.NYCAPS_JobID
End Sub
Private Sub Form_Load()
varSplitString = Split(Me.OpenArgs, "|")
Me.[FullName].Value = varSplitString(0)
Me.[PATS Job Opening ID].Value = varSplitString(1)
Me.[NYCAPS_JobID].Value = varSplitString(2)
End Sub
and them on the form load I typed
Any help will be appreciated
You have to be extremely attentive with all those commas in the DoCmd.OpenForm options list. It's just way too darn easy to cause a misalignment between what you and Access think about which values apply to which options.
In your case you intend to pass a string, Me.txtFullName & "|" & Me.PATS_Job_Opening_ID & "|" & Me.NYCAPS_JobID, to OpenArgs. Unfortunately you omitted a comma, so Access thinks you're feeding it a value for WindowMode, which is supposed to be a number. Therefore, error 13: "type mismatch"!
Do it this way and you eliminate any confusion about which value goes with which option.
Dim strArgs As String
strArgs = Me.txtFullName & "|" & Me.PATS_Job_Opening_ID & "|" & Me.NYCAPS_JobID
Debug.Print strArgs ' make sure you got what you expect '
DoCmd.OpenForm FormName:="frmInputInfo", _
DataMode:=acFormAdd, _
WindowMode:=acDialog, _
OpenArgs:=strArgs
Also in the form event, make sure you got something for OpenArgs before you attempt to Split it. As it stands now, if the form is ever opened without supplying OpenArgs, your code will essentially attempt Split(Null, "|") and that will trigger a different error.
You can test before split like this:
If Len(Me.OpenArgs) > 0 Then
' do your split thing here '
End If

VBA returning a value and error information together

I am writing some VBA in MS Access, although the principle of my question would apply just as well to Excel or Word VBA. I have written a function GetStringParameterFromTable which returns a string value. It is possible that the function may result in a VBA-generated error, despite my best efforts to write it so that it does not. If an error happens, I don't want the code to crash, so I must use error handling. However, I don't want the code to display an error message and stop within the function if there is an error. I want the function to finish executing and return control to the calling procedure, and then I want the calling procedure to display the error message and tidy up, e.g. close open files. My question is: how does the calling procedure know that there has been an error in the function it called, and how does it get the error message?
I have thought of three ways of implementing this:
(1) Make GetStringParameterFromTable into a Sub, and pass it ParameterValue, ErrorFlag and ErrorMessage by reference.
(2) Keep GetStringParameterFromTable as a Function, define ErrorFlag and ErrorMessage as global variables and have the function alter ErrorFlag and ErrorMessage.
(3) Keep GetStringParameterFromTable as a Function and define a type with three components – ParameterValue, ErrorFlag and ErrorMessage – and make GetStringParameterFromTable return a value of the type I have defined.
I think that my requirement must be quite common, but I can’t find any examples of how it’s implemented. Does anyone have any views on which of my suggestions is the best way, or whether there is a better way that I haven’t thought of?
I have been contemplating the same thing since C#.net has implemented Tuples. I have implemented Tuples using VBA's type to create my tuples. What I have done is the following:
Public Type myTuple
Value as String 'Or whatever type your value needs to be
ErrCode as Long
ErrDesc as String
End Type
Public Function DoWork (ByRef mObject as MyClass) as myTuple
Dim retVal as myTuple
'Do whatever work
If Err.Number <> 0 then
retVal.Value = Nothing
retVal.ErrNumber = Err.Number
retVal.ErrDesc = Err.Description
Else
Set retVal.Value = Whatever Makes Sense
retVal.ErrNumber = 0
retVal.ErrDesc = VbNullString
End If
DoWork = retVal
End Function
I would like to be more specific, but you didn't provide a code example.
I am doing it like this and log the errors in a table:
' Lookups Replacements
'---------------------
Function DLook(Expression As String, Domain As String, Optional Criteria) As Variant
On Error GoTo Err_Handler
Dim strSQL As String
strSQL = "SELECT " & Expression & " FROM " & Domain 'DLookup
'DCount: strSQL = "SELECT COUNT(" & Expression & ") FROM " & Domain
'DMax: strSQL = "SELECT MAX(" & Expression & ") FROM " & Domain
'DMin: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DFirst: strSQL = "SELECT FIRST(" & Expression & ") FROM " & Domain
'DLast: strSQL = "SELECT LAST(" & Expression & ") FROM " & Domain
'DSum: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DAvg: strSQL = "SELECT AVG(" & Expression & ") FROM " & Domain
If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria
DLook = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
Exit Function
Err_Handler:
'Can be made as Error Sub as well
Dim ErrNumber as Integer
Dim ErrDescription as String
ErrNumber = Err.Number
ErrDescription = Err.Description
Err.Clear
On Error Resume Next
Dim strSQL as String
strSQL = "INSERT INTO tblErrorLog (ErrorNumber, ErrorDescription) VALUES (" & ErrNumber & ", '" & ErrDescription & "')"
Currentdb.Excecute strSQL, dbFailOnError
End Function
Called with:
If DLook("Column2", "Table1", "Column1 = " & ID) = 0 Then
'Do stuff
End If
If DLook("Column2", "Table1") = 0 Then
'Do other stuff
End If

Multi-Field Searching that show results as you type

I had gotten my question answered by a colleague of mine, but I wanted to re-post here in case anyone else has the issue, and to pose the question, which you'll note at the end. The original post, if interested, is here: Original Post
Many thanks to all in the community here, particularly #Andre for your help!
It was strange, but when I did that, it kept trying to put in all my letters backwards. Example: If I searched "Smith", it would enter it as "htims". I'm sure it had something to do with the on click event, but I had a friend look at it and I think she cracked it! It looks like this (I've added a comment to what the new line(s) of code is/are):
First, the textbox click event whereby when you click the box, it clears the text and resets the search (no need for a reset button)
Private Sub txtSearch_Click()
Me.txtSearch.SetFocus 'new line of code
Me.txtSearch.Text = ""
Me.Requery
With Me.txtSearch
.SetFocus
.SelStart
End With
End Sub
This is the actual search, that will search multiple fields
Private Sub txtSearch_Change()
Dim strFilter As String
Dim sSearch As String
On Error Resume Next
If Me.txtSearch.Text <> "" Then
sSearch = "'*" & Replace(Me.txtSearch.Text, "'", "''") & "*'"
strFilter = "[Last_Name] Like " & sSearch & " OR [First_Name] Like " & sSearch & " OR [SSN] Like " & sSearch
Me.Filter = strFilter
Me.FilterOn = True
Else
Me.Filter = ""
Me.FilterOn = False
End If
If Me.Recordset.RecordCount = 0 Then 'new line of code
Me.Filter = "" 'new line of code
Me.FilterOn = False 'new line of code
Me.txtSearch.SetFocus 'new line of code
Me.txtSearch.Text = "" 'new line of code
Exit Sub 'new line of code
End If 'new line of code
With Me.txtSearch
.SetFocus
.SelStart = Len(Me.txtSearch.Text)
End With
End Sub
This seems to be working great. And while I'm considering this issue complete, I do have a question, if you could help me identify, why were the letters going in backwards when I replaced the .Text with a .Value?
Thank you all very much for your help!
First you need to change the Click event to Enter and scrap the .SetFocus since the control will have the focus:
Private Sub txtSearch_Enter()
With Me
.txtSearch.Value = ""
.Requery
End With
End Sub
Regarding the difference between .Text and .Value:
The .Text property updates with every keystroke you make where the .Value property gets updated only when the control loses focus.
On the Change event, you should check two things: a) the textbox has a value (.Text) to apply the filter and b) the recordcount to clear the filter if no records returned.
Private Sub txtSearch_Change()
Dim strFilter As String, sSearch As String
On Error Resume Next
With me
If .txtSearch.Text <> "" Then
sSearch = "'*" & Replace(.txtSearch.Text, "'", "''") & "*'"
strFilter = "[Last_Name] Like " & sSearch & " OR [First_Name] Like " & sSearch & " OR [SSN] Like " & sSearch
.Filter = strFilter
.FilterOn = True
End If
If .Recordset.RecordCount = 0 Then
.Filter = ""
.FilterOn = False
End If
End With
End Sub
The reason for the backward letters, was the .SelStart property where the cursor was jumping at the beginning every time you typed a letter, thus giving you the impression it was flipping the word backwards.

How can I determine the difference between typing into a combo box and selecting from a drop down in Access VBA?

This question was asked in the topic with a similar name earlier, but the answer provided didn't really indicate HOW those events would help determine whether somebody was typing in the combo box or selecting an item in the list. I think that it really answered the other question about how to determine when somebody was done typing, but without seeing the event handlers, I can't be sure.
Unfortunately, I'm new here and don't have enough reputation to post a comment asking for clarification, so I have to start a new question. Here's what I'm trying to do:
I have a form with a combo box in the Header and, as I type in the combo box, I want the characters that I've typed to be used as a filter on the Details part of the form. Both the combo box control source and the form's record source use the same query string.
I've tried numerous iterations of the code below, but I can't get it to work correctly.
Private Sub cmbAppName_Change()
Dim strApp As String
Dim nSelStart As Integer
Dim nSelLen As Integer
Dim nSelected As Integer
Dim strMsg As String
On Error GoTo ERR_SUB
strMsg = ""
Me.cmbAppName.SetFocus
' Get current selection details
nSelStart = Me.cmbAppName.SelStart
nSelLen = Me.cmbAppName.SelLength
nSelected = Me.cmbAppName.ListIndex
Me.cmbAppName.SetFocus
strApp = Nz(Me.cmbAppName.Text, "")
Debug.Print "Index = " & nSelected & "; SelStart = " & nSelStart & "; SelLen = " & nSelLen
If nSelected = -1 Then
Debug.Print "Change by typing: " & strApp
Else
Debug.Print "Change by list selection: " & strApp
End If
' Get the part of the text that the user has typed
If nSelStart > 0 Then
strApp = Left(strApp, nSelStart)
Debug.Print "App piece = '" & strApp & "'"
End If
' If there is text, set a filter (MatchAppName = InStr(strApp, datbase_column_value)
If strApp <> "" Then
Me.Filter = "MatchAppName('" & strApp & "', " & DCApplications_Application_Col & ") > 0"
Me.FilterOn = True
' Me.txtApplication.SetFocus
' Call DoCmd.FindRecord(strApp, acStart, False, acSearchAll, False, acCurrent, True)
' Me.cmbAppName.SetFocus
Else
Me.Filter = ""
Me.FilterOn = False
End If
EXIT_SUB:
' Restore the selection in the combo box's text box
Me.cmbAppName.SetFocus
Me.cmbAppName.SelStart = nSelStart
Me.cmbAppName.SelLength = nSelLen
Exit Sub
ERR_SUB:
If ERR.Number = 2185 Then
strApp = Nz(Me.cmbAppName.Value, "")
Me.cmbAppName.SetFocus
Debug.Print "Using " & strApp
Resume Next
End If
Me.Filter = ""
Me.FilterOn = False
Debug.Print ErrorMessage(ERR.Description, "cmbAppName_Change", ERR.Number, "Value = '" & Me.cmbAppName.Value & "'", False)
Resume EXIT_SUB
End Sub ' cmbAppName_Change
As you can see from the error handling code, I'd often get an error 2185 telling me that my control didn't have focus when using the Text property despite having a SetFocus call right before it.
If somebody selects from the list (either by clicking or moving the selection), I'd like to go to that record, but I at least need the above piece working first.
After searching the Web, I found out that a Details section with zero records causes the 2185 error. Apparently, filtering like that causes problems when all records are filtered out.
The solutions on the Web said that you can set the Allow Additions property of the form to True, but that always displays one row in the Details section. This can be especially confusing if the rows in the Details section contain controls, which will be displayed in the "addition" row. Also, I would still get an error typing additional characters after the one that caused the Details section to have zero records.
Eventually, I replaced the combo box with a simple text control to filter the Details section. When the Details section has rows, I turn Allow Additions off and make the controls visible; when it doesn't have rows, I turn Allow Additions on and hide the controls.
Here's the code that I used:
Private Sub txtApplicationFilter_Change()
Dim strApp As String
Dim nSelStart As Integer
Dim nSelLen As Integer
Dim strFilter As String
Dim strQuery As String
Dim strWhere As String
Dim nRecs As Integer
On Error GoTo ERR_SUB
' Save text selection
nSelStart = Me.txtApplicationFilter.SelStart
nSelLen = Me.txtApplicationFilter.SelLength
' Get application name typed and selection information
strApp = Nz(Me.txtApplicationFilter.Text, "")
strFilter = "[" & DCApplications_Application_Col & "] LIKE '*" & EscapeQuotes(strApp) & "*'"
nRecs = DCount("[" & DCApplications_Application_Col & "]", LocalTableName(DCApplications_Tab), strFilter)
' Kludge code to prevent various errors (like 2185) when no records are returned in the form
Call UpdateList(nRecs)
' Update the record source to reflect the filtered list of apps
strWhere = " WHERE APPS." & strFilter
strQuery = strSelect & strFrom & strWhere & strOrderBy
Me.RecordSource = strQuery
' 20200423 SHM: Restore or update filter to avoid issues with Delete and Backspace and applications with spaces in their names
Me.txtApplicationFilter.SetFocus
Me.txtApplicationFilter = strApp
Me.txtApplicationFilter.SelStart = nSelStart
Me.txtApplicationFilter.SelLength = nSelLen
EXIT_SUB:
Me.btnAddNew.enabled = (Nz(Me.txtApplicationFilter, "") <> "")
Exit Sub
ERR_SUB:
' NOTE: ErrorMessage is a helper function that basically displays a form displaying the error
Call ErrorMessage(ERR.Description, "txtApplicationFilter_Change", ERR.Number, "Filter = " & strApp & " Records = " & nRecs)
Resume EXIT_SUB
Resume Next
End Sub ' txtApplicationFilter_Change
Private Sub UpdateList(nRecs As Integer)
Dim bShowControls As Boolean
On Error GoTo ERR_SUB
bShowControls = (nRecs > 0)
' Kludge code to turn off checkbox control source
If bShowControls Then
strSelect = strSelectStart & ", (" & strAppUser & ") AS " & strCtrlSource
Me.chkTestedByMe.ControlSource = strCtrlSource
Else
strSelect = strSelectStart
Me.chkTestedByMe.ControlSource = ""
End If
' Kludge code to prevent various errors (like 2185) when no records are returned in the form
' Turning on AllowAdditions prevents errors when no records are returned.
' However, that puts an empty row in the form, but the controls are showing, so we have to hide them to prevent confusing the user.
Me.AllowAdditions = Not bShowControls
Me.btnAddExisting.visible = bShowControls
Me.chkTestedByMe.visible = bShowControls
EXIT_SUB:
Exit Sub
ERR_SUB:
Call ErrorMessage(ERR.Description, "UpdateList", ERR.Number, " Records = " & nRecs)
Resume EXIT_SUB
Resume Next
End Sub ' UpdateList
I would use a work around to settle this issue
A simple code bellow demonstrate the work around using Tag property of Combo Box and keypress event along with change event, I hope it can be applied in your code
Private Sub Combo2_Change()
If Combo2.Tag = 1 Then
Text4 = "change - from key"
Else
Text4 = "change - from select"
End If
Combo2.Tag = 0
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
Combo2.Tag = 1
End Sub
Don't forget to set Tag property of Combo Box to 0 on design view to avoid error at comparing empty Tag with number

filter continuous form using textbox

I need to let users filter a continuous form using values the user enters into a textbox. And the continuous form is also nested within a couple levels of navigation subforms. This sounds easy enough, but all the examples I find on the web use macros instead of vba.
I set up the structure and wrote an AfterUpdate procedure for a textbox txtFilter as follows:
Private Sub txtFilter_AfterUpdate()
Dim filterval As String
filterval = txtFilter.Value
With Forms!Main!NavigationSubform.Form!NavigationSubform.Form
.Filter = "LastName Like " & filterval
.FilterOn = True
End With
End Sub
I have played with different syntax, but none of it seems to work properly. Here is a link to download the relevant parts of the database from a file sharing site: http://jmp.sh/v/HGctZ4Ru74vDAjzN43Wq
Can anyone show me how to alter this so that users can use the textbox to filter the continuous form?
I got it to work using this: .Filter = "LastName Like """ & filterval & """"
Need those annoying String Identifiers even for strings sometimes.
Okay, To get the form to open with no records and then pull up just the records you (or the user) specifies is easiest with a bit of re-work.
(I'd recommend you working with a copy and not your original)
1:On your Continuous Form, remove the Recordsource; we're going to use Late Binding (Kinda)
2:Then delete the code under the txtFilter box, then delete the box itself.
3:Add a comboBox with something like this as the recordsource:
SELECT DISTINCT myTable.LastName FROM myTable ORDER BY myTable.LastName; (This will get you a unique list of last names so knowing how to spell the name will not be necessary, plus it assures at least one match)
4:In the After Update event of that combobox, add code like this:
Dim strSource As String
strSource = "SELECT mt.IntakeNumber, mt.ClientNumber, " & _
"mt.LastName, mt.FirstName, mt.ConsultationDate " & _
" FROM myTable mt " & _
"WHERE (mt.LastName)= '" & Me.cboFilter.Value & "'"
Me.RecordSource = strSource
Me.Requery
Obviously you'll need to change the table and field names as necessary, but hopefully you get the idea.
Option Compare Database
Option Explicit '<- always include this!!!!!
Private Sub txtFilter_AfterUpdate()
Dim strFilter As String
' only set Filter when text box contains something
' to search for ==> don't filter Null, empty string,
' or spaces
If Len(Trim(Me.txtFilter.Value & vbNullString)) > 0 Then
strFilter = "LastName Like '*" & _
Replace(Me.txtFilter.Value, "'", "''") & _
"*'"
' that Replace() prevents the procedure from breaking
' when the user enters a name with an apostrophe
' into the text box (O'Malley)
Debug.Print strFilter ' see what we built, Ctrl+g
Me.Filter = strFilter
Me.FilterOn = True
Else
' what should happen here?
' maybe just switch off the filter ...
Me.FilterOn = False
End If
End Sub