I'm in the process of converting an Access Data Project (ADP) into a standard ACCDB format with ODBC linked tables. In the ADP, I had overridden the Refresh button to return the user to the current record by using the following code:
Public Sub RibbonCmd_RefreshScreen(ctl As IRibbonControl, ByRef cancelDefault)
On Error GoTo ErrHandler
cancelDefault = False
DoCmd.Echo False
Dim saveBookmark
With Screen.ActiveForm
saveBookmark = .Bookmark
.Requery
.Bookmark = saveBookmark
End With
'Success - cancel the default behavior
cancelDefault = True
ExitHandler:
DoCmd.Echo True
Exit Sub
ErrHandler:
cancelDefault = False
Resume ExitHandler
End Sub
My understanding is that this should work just fine with DAO, but I get error 3159, Not a valid bookmark. I've also tried replacing .Bookmark with .Recordset.Bookmark, but that gave me the same result. Is there something I'm doing wrong here?
Actually, a requery of a form or a requery of a recordset will re-set and invalidate book marks.
So such book marks are no longer valid after a requery.
So the best approach here will depend on either
a) I simply want to re-display any changed records (and not move off current record).
b) I simply want to re-display any changed records AND ALSO display new records (the new records is the critical part).
If you just need a refresh, then you can use the appropriately called command refresh.
Eg:
Me.Refresh
Or in your case
Screen.ActiveForm.Refresh
So the above is ONE line of code and is ALL you need. The current record pointer for the form does NOT change when you use this command. All and any record changed will re-display for you.
Note that since you can behind the form button use:
Me.Refresh
Then LITTLE need is required to call a general routine as you have written.
However, if you need the form to "load" or display any new records added, then you DO have to use requery. In this case as noted book marks in this case all become invalid.
So, for code to requery, then we use the PK value (and hopefully you used the default pk of ID that been the default for 20 years). The code would then become:
Dim lngID As Long
If IsNull(Me!ID) Then Exit Sub
lngID = Me!ID
Me.Requery
Me.Recordset.FindFirst "id = " & lngID
Now of course if the PK id is not the same for each form, then you most certainly could pass the NAME of the PK value to your "general" refresh routine. It would look like:
Public Sub MyRefresh(strPK As String)
Dim lngID As Long
If IsNull(Me(strPK)) Then Exit Sub
lngID = Me(strPK)
Me.Requery
Me.Recordset.FindFirst strPK & " = " & lngID
End Sub
The "hope" here is you actually really JUST need refresh, since as noted this is only one line of code, and better yet it does NOT move the record pointer.
I use VB6 and Visual Data Manager in development. I have had the same problem. Most probably it arose when 2 users tried to update the same record in the same time. So some fields in the table are corrupted.
Here are the steps I used to solve the problem:
1- Copy the structure of the table (lets call it table1)to another table (lets call it table2).
2- Find the correpted record(s) in table1.
3- Transfer the data from table1 to table2 except the corrupted record(s)
4- Reenter the excluded record(s) to table2 again.
5- Rename table1 table3
6- Rename table2 table1
That's all folk
abdobox#yahoo.com
I have used the forms Recordset.AbsolutePosition, and this works fine e.g. in the OnKeyDown exit of a field
Dim PrefilterPosition As Long
Private Sub ValnSubject_KeyDown(KeyCode As Integer, Shift As Integer)
' Not F2 - exit
If KeyCode <> vbKeyF2 Then Exit Sub
' Get the active control
Dim ActiveCtl As Control
Set ActiveCtl = Me.ActiveControl
ActiveControlName = ActiveCtl.Name
' Is the form's filter set?
If Me.Filter = "" Then
' NO: Apply the new filter
' Note the current position in the recordset
PrefilterPosition = Me.Recordset.AbsolutePosition
' Set the filter to the Active control's value
Me.Filter = "[" & ActiveCtl.ControlSource & "]='" & ActiveCtl.Value & "'"
Me.FilterOn = Me.Filter <> ""
Me.Requery
Else
' YES: Clear the filter
Me.Filter = ""
Me.FilterOn = Me.Filter <> ""
Me.Requery
' Align the recordset on the previously stored position
Me.Recordset.AbsolutePosition = PrefilterPosition
End If
' Restore the cursor to where it came from
Me.Controls(ActiveControlName).SetFocus
Ex_it:
End Sub
For context: this code was from an idea for an 'Instant Filter', where you position the cursor on a field in a tab form, press F2, and then a filter is applied so you see only records with the selected field's value. Press F2 again and the filter is removed and the cursor goes back into the place it was when you hit F2 the first time. Bookmarks do not work here, as Albert says above.
Related
I have an Access 2016 DB 64bits contain related tables with a search split form that have an txtBox that filtered records accoring to its entered value.
Every thing is just fine with that for months and with thousands of records.
When I want to make it more proffesional to deploy it to other users by re-writing another similar DB but with 32bts Access 2016 and SPLIT it from the start into Tables Back-end and a Front end, the search form didn't show any record when I fire a searching parameter in the after update event!
the search form is linked to a query, I change it to a new one, also try to link the form directly to only one table for testing also not goes right, shows zero results.
when remove the filter, all records showing up again.
when I change the filter directly from the form properties it also fail for string search but when search for a primary key in a form control holding it its working just fine. ( search for Strings show no results, search for Numbers ( ex ID value, show correct results).
And Very strange, when I build another new DB (Same access application) just for testing for what is going on, with a form and joined to split back end tables and a textbox in the form to enter keywords to show the all related records in the that split form, it works fine, both for strings and for numbers?
Private Sub txtSearch_AfterUpdate()
Dim strFilter As String
On Error Resume Next
If Me.txtSearch.Text <> "" Then
strFilter = "[Complaints] Like '*" & Me.txtSearch.Text & "*'"
Me.Filter = strFilter
Me.FilterOn = True
Else
Me.Filter = ""
Me.FilterOn = False
End If
With Me.txtSearch
.SetFocus
.SelStart = Len(Me.txtSearch.Text)
End With
End Sub
when put a string into the txtsearch box , the code must search for any string with in [Complaints] similar to it and shows the records holding it.
with me it works in the old DB 64bits Not splitted, but its not working for the new DB 32bits split to back and front ends.
Be careful using .Text as it requires the control to have focus. So try:
Private Sub txtSearch_AfterUpdate()
Dim strFilter As String
' On Error Resume Next ' Don't use while debugging.
If Nz(Me!txtSearch.Value) <> "" Then
strFilter = "[Complaints] Like '*" & Me!txtSearch.Value & "*'"
Me.Filter = strFilter
Me.FilterOn = True
Else
Me.Filter = ""
Me.FilterOn = False
End If
With Me!txtSearch
.SetFocus
.SelStart = Len(.Value)
End With
End Sub
I have a Continuous subform that filters data based on a series of queries. I then need to populate a subform that I have placed in the footer based on some data, and I have crafted a query to accomplish this.
Private Sub UpdateXXXXX_Info()
If (Me.FormFooter.Visible <> True) Then
Me.FormFooter.Visible = True
End If
MsgBox "query start"
LabelXXXXX_.Caption = "XXXXX for: " & Me.[XXXXX__NAME] & " " & Me.[XXXXX__NAME] & " " & Me.[XXXXX__CATEGORY_NAME]
With CurrentDb.QueryDefs("XXXXX_Query")
.Parameters("XXXXXParam") = Me.[XXXXX_NAME]
.Parameters("XXXXXCategoryParam") = Me.[XXXXX_CATEGORY_NAME]
Set Me.XXXXX__Subform.Form.Recordset = .OpenRecordset
.Close
MsgBox "query complete"
End With
End Sub
Which gets called from Click events tied to each of the controls on the continuous form. This works great, and filters as I expect.
Due to the nature of the continuous form (which itself is a subform of another form), the entire continuous form may need to be refreshed:
Private Sub Form_Current()
Me.FormFooter.Visible = False
End Sub
Which is causing an issue when refreshing the data. It works as-expected the first time around, however clicking on another record in the top continuous form causes the subform to prompt for query parameters. Based on testing, it is doing this when setting Me.FormFooter.Visible = True; although not setting Visible = False in the Current event circumvents this (which produces other, undesirable behavior).
Access will not let me .Close the Recordset, or otherwise set it to a blank or null value. I also cannot find any way to set the parameters for a Requery. The amount of data being presented also prohibits me from pulling the full table and applying a filter instead.
How can I prevent this behavior?
Edit: For clarification, I must use stored queries as a business requirement.
Use an SQL statement to (re)create the recordsource of the subform instead.
SQL = "SELECT * FROM xQuery WHERE xParam = '" & me!Name & "'" AND " & _
"xCategoryParam = '" & me!CategoryName & """
me!subform.form.recordsource = SQL
This eliminates any requirements to open/close the recordset, and avoids having to change your original query definition. (i.e. create your parameterless query, and the WHERE command in the SQL does the heavy lifting for you.
Aha!
geeFlo's answer pointed me to the RecordSource property of the form. Playing around with that, I was able to come up with the following:
Private Sub ClearXXXXXInfo()
If Me.FormFooter.Visible = True Then
Me.XXXXX_Subform.Form.RecordSource = ""
Me.FormFooter.Visible = False
End If
End Sub
Private Sub Form_Current()
ClearXXXXXInfo
End Sub
Does MS Access allow to get the recordsource value of the form without opening the form itself? I'm trying to optimize my code as of now, what I did is I just hide the form then get the Recordsource form query but it takes time to load since some of the forms trigger a code upon onload.
I'm late to the game here - I sometimes post answers months or years after the original question was posted, as I post my own solutions when a quick search of the 'Stack finds questions relevant to my own problem of the day, but no answers that I can actually use.
[UPDATE, 06 June 2016]
The 'NameMap' property is not available in document objects from Access 2010 onwards. However, 'Stacker Thunderframe has pointed out that this is now available in the 'MsysNameMap' table.
I have amended the code, and this works in Access 2010 and 2013.
[/UPDATE]
Most of a form's properties are only available when the form is open, but some are available in the form's entry in the DAO Documents collection.
The DAO 'document' is a horrible object: it won't persist in memory and you have to refer to it explicitly every time you use it:
FormName = "MyForm"
For i = 0 To Application.CodeDb.Containers("Forms").Documents(FormName).Properties.Count - 1
Debug.Print i & vbTab & Application.CodeDb.Containers("Forms").Documents(FormName).Properties(i).Name & vbTab & vbTab & Application.CodeDb.Containers("Forms").Documents(FormName).Properties(i).Value
Next
Run that snippet for your form, and you'll see a 'NameMap' property that contains a list of the form's controls, and some of the form's properties.
...In a truly horrible format which needs a binary parser. You might want to stop reading and take an aspirin, right now, before continuing.
Health Warnings:
The NameMap Property is undocumented. It is therefore unsupported and there is no guarantee that this solution will work in future versions of Microsoft Access.
The solution in my code below will stop working if the NameMap's two-byte binary label for a Record Source ever changes, or if it's locale-specific.
This is a horrible hack: I accept no liability for any effects on your sanity.
OK, here's the code:
A VBA function to return the Record Source from a closed MS-Access form:
Private Function FormRecordSource_FromNameMap(FormName As String) As String
' Reads the Record Source from the NameMap Property of the Document object for the form.
' WARNING: there is a potential error here: if the form's RecordSource property is blank
' and it has one or more list controls with a .RecordSource property populating
' the list, this function will return the first list control's Record Source.
' This won't work if you're using non-ASCII characters (Char > 255) in your form name.
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim arrByte() As Byte
Dim strOut As String
If Application.Version < 12 Then
arrByte = Application.CodeDb.Containers("Forms").Documents(FormName).Properties("NameMap").Value
For i = 1 To UBound(arrByte) - 2 Step 2
' 2-byte marker for a querydef in the NameMap:
If (arrByte(i) = 228 And arrByte(i + 1) = 64) Then
j = i + 2
Do While arrByte(j) = 0 And arrByte(j + 1) = 0 And j < UBound(arrByte)
' loop through the null chars between the marker and the start of the string
j = j + 2
Loop
strOut = ""
Do Until (arrByte(j) = 0 And arrByte(j + 1) = 0) Or j >= UBound(arrByte) - 2
If arrByte(j) = 0 Then j = j + 1
' loop until we reach the null char which terminates this string
' appending the Bchars (not unicode Wchars!) of the table or query
strOut = strOut & Chr(arrByte(j))
j = j + 2
Loop
Exit For ' we only want the first datasource
End If
Next i
Else
arrByte = Nz(DLookup("[NameMap]", "[MSYSNameMap]", "[Name] = '" & FormName & "'"), vbNullChar)
If UBound(arrByte) < 4 Then Exit Function
strOut = ""
For j = 60 To UBound(arrByte) - 2 Step 2
If arrByte(j) = 0 And arrByte(j + 1) = 0 Then Exit For
strOut = strOut & Chr(arrByte(j))
Next j
End If
frmRecordSource_FromNameMap = strOut
Erase arrByte
End Function
If you use the RecordSource in (say) OpenRecordset or a DCOUNT function, I would advise you to encapsulate it in square brackets: you might get the name of a hidden query object saved from a 'SELECT' statement in the RecordSource, and that name will contain '~' tilde characters which need special handling.
And now, something extra that you didn't ask for, but other people will be looking for if they Googled their way here for 'MS Access RecordSource for a closed form':
Getting an MS-Access form's RecordSource, whether it's open or not
Most times, your form will be open. Problem is, you don't know that... And if it's a subform, it might not be visible in the Forms() collection. Worse, a form that's hosted as a subform might exist as multiple instances in several open forms.
Good luck with that, if you're looking to extract dynamic properties... Like filters, or the Record Source if it's set 'on the fly' by VBA.
Public Function GetForm(FormName As String, Optional ParentName As String = "") As Form
' Returns a form object, if a form with a name like FormName is open
' FormName can include wildcards.
' Returns Nothing if no matching form is open.
' Enumerates subforms in open forms, and returns the subform .form object if
' it has a matching name. Note that a form may be open as multiple instances
' if more than one subform hosts it; the function returns the first matching
' instance. Specify the named parent form (or the subform control's name) if
' you need to avoid an error arising from multiple instances of the form.
Dim objForm As Access.Form
If ParentName = "" Then
For Each objForm In Forms
If objForm.Name Like FormName Then
Set GetForm = objForm
Exit Function
End If
Next
End If
If GetForm Is Nothing Then
For Each objForm In Forms
Set GetForm = SearchSubForms(objForm, FormName, ParentName)
If Not GetForm Is Nothing Then
Exit For
End If
Next
End If
End Function
Private Function SearchSubForms(objForm As Access.Form, SubFormName As String, Optional ParentName As String = "") As Form
' Returns a Form object with a name like SubFormName, if the named object SubFormName is subform
' of an open form , or can be recursively enumerated as the subform of an open subform.
' This function returns the first matching Form: note that a form can be instantiated in multiple
' instances if it is used by more than one subform control.
Dim objCtrl As Control
For Each objCtrl In objForm
If TypeName(objCtrl) = "SubForm" Then
If objCtrl.Form.Name Like SubFormName Then
If ParentName = "" Or objForm.Name Like ParentName Or objCtrl.Name Like ParentName Then
Set SearchSubForms = objCtrl.Form
Exit For
End If
Else
Set SearchSubForms = SearchSubForms(objCtrl.Form, SubFormName, ParentName)
If Not SearchSubForms Is Nothing Then
Exit For
End If
End If
End If
Next objCtrl
End Function
Public Function FormRecordSource(FormName As String, Optional ParentName As String = "") As String
' Returns the Recordsource for a form, even if it isn't open in the Forms() collection
' This will look for open forms first. If you're looking for a subform, you may need a
' parent name for the form which hosts the subform: your named form might be open as a
' subform instance in more than one parent form.
' WARNING: there is a potential error here: if the form isn't open, and it has a blank
' RecordSource property, and it has one or more controls with a .RecordSource
' property populating a list, a list control's RecordSource could be returned
Dim objForm As Form
If FormName = "" Then
Exit Function
End If
Set objForm = GetForm(FormName, ParentName)
If objForm Is Nothing Then
FormRecordSource = FormRecordSource_FromNameMap(FormName)
Else
FormRecordSource = objForm.RecordSource
Set objForm = Nothing
End If
End Function
Share and enjoy: and please accept my apologies for any unwanted line breaks in the code sample.
One option would be to save the Record Source of the form as a Query. Say you have a form named [AgentForm] whose Record Source is
SELECT ID, AgentName FROM Agents
In your development .accdb copy of the database, open the form in Design View and open the Record Source in the Query Builder. Click the "Save As" button ...
and save the query as "AgentForm_RecordSource". Now the Record Source property of the form is just a reference to the saved query, and the query itself can be accessed directly through a QueryDef object. So, you could retrieve the SQL statement for the form's Record Source with
Dim cdb As DAO.Database, qdf As DAO.QueryDef, sql As String
Set cdb = CurrentDb
Set qdf = cdb.QueryDefs("AgentForm_RecordSource")
sql = qdf.SQL
or you could go ahead and open a Recordset with
Dim cdb As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Set cdb = CurrentDb
Set qdf = cdb.QueryDefs("AgentForm_RecordSource")
Set rst = qdf.OpenRecordset
If the form's Record Source is a SELECT statement rather than the name of a table or saved query, you can check the QueryDefs collection for the hidden QueryDef which Access created for that Record Source statement.
If it exists, you can check its .SQL property.
strFormName = "Form15"
? CurrentDb.QueryDefs("~sq_f" & strFormName).SQL
SELECT DISTINCTROW *
FROM [DB Audits];
You can trap error #3265, "Item not found in this collection", which will be thrown if that QueryDef does not exist.
Since you can't open your form in design view and opening your form regularly is causing performance issues, there are but a few more workarounds:
Depending on how you want to check for the closed form's recordsource, you can set a global variable in the following way, in a separate module:
Public glb_getrecordsource As String
Afterwards, depending on how you call the code, you can do the following:
Private Sub Command1_Click()
glb_getrecordsource = "Yes"
DoCmd.OpenForm "Form1"
'... Do something
End Sub
Then, as the final step, put the following at the beginning of your form's OnLoad event:
Private Sub Form_Load()
If glb_getrecordsource = "Yes" Then
glb_getrecordsource = Me.Form.RecordSource
DoCmd.Close acForm, "Form1", acSaveYes
Exit Sub
End If
'... Usual OnLoad events
End Sub
This will at least solve the performance issues, since you will not trigger any of the time consuming events, in the form's load event.
Another workaround:
You can export your form to a .txt file and then search the text file for the recordsource. The following code will export your forms to .txt files in a specified folder:
Dim db As Database
Dim d As Document
Dim c As Container
Dim sExportLocation As String
Set db = CurrentDb()
sExportLocation = "C:\AD\" 'Do not forget the closing back slash! ie: C:\Temp\
Set c = db.Containers("Forms")
For Each d In c.Documents
Application.SaveAsText acForm, d.Name, sExportLocation & "Form_" & d.Name & ".txt"
Next d
Code partly borrowed from this forum. Afterwards, you only have to open the file and search for the recordsource. If the recordsource is empty it will not be exported, so keep that in mind. Also, I doubt this will improve perfomance, but who knows!
Hi I'm using Access 2007 and i am doing a program to enter stock items.
I am using a form and i need to make sure that when the user inputs the barcode of the product the system checks in the table if this exists. If it does exists, i need to load data for this existing item into the 3 additional fields in the same form, otherwise to continue creating the new record.
Now i am trying to use set tempvar in the beforeupdate however i cannot get it right.
any suggestions please.
field name : [barcode]
table to look into is "cartridge static data"
additional fields to fill if barcode exists are : [cartridge] , [end user] , [phone no]
Appreciate any help
regards
Tony
I would insert a combo box using the Access wizzard.
Select the data from "cartridge static data" i.e. [barcode] [cartridge] [end user] [phone no]
Do not hide the first row, and make sure you can see the data width in the wizard as you build it.
When completed go to the combo [data] [row source] and click the three {…}
Check what is displayed ~ for example sort by Barcode, remove nulls etc.
If you have the column widths wrong you can change those in the [format tab].
Column headers default to No which may need changing or you may be happy with that.
Under [other] name check you have a sane name e.g. cbo_barcode_search
Now attach this code to the AfterUpdate property of the Combo Box:
Sub cbo_barcode_search_AfterUpdate ()
Dim rs As DAO.Recordset
If Not IsNull(Me.cbo_barcode_search) Then
'Save before move.
If Me.Dirty Then
Me.Dirty = False
End If
'Search in the clone set.
Set rs = Me.RecordsetClone
rs.FindFirst "[BarCode] = " & Me.cbo_barcode_search
'rs.FindFirst "[BarCode] = """ & Me.cbo_barcode_search & """" 'for text
If rs.NoMatch Then
'Trigger new form or add the just typed data into your form as required
‘e.g. me.field1 = cbo_barcode_search.column(0) ' Barcode
Else
'Display the found record in the form.
' Usually use Me.Bookmark = rs.Bookmark but your question suggests this is not what you want so
'NOTE: First column data is column(0) NOT column(1)
me.field1 = cbo_barcode_search.column(0) ' Barcode
me.field2 = cbo_barcode_search.column(1) ' Cartridge
me.field3 = cbo_barcode_search.column(2) ' end user
me.field4 = cbo_barcode_search.column(3) ' phone no
End If
Set rs = Nothing
End If
End Sub
You will need to modify this to match your field names (eg me.field1 is probably me.barcode but it may be me.str_barcode ~ I don't know what you used.
Hope this gets you on the right track. Paul
First off I'd like to make perfectly clear that my knowledge of Access and VBA is extremely limited at best. I have an employee database system that due to it's age has been prone to small data corruption issues and controls breaking due to differences between 2003/2007 and 2010. While I've managed to hash out the bulk of the problems, one that has me especially concered is the script we're using to manage access to the database. The system is split between two files, a frontend where users can access the database and a backend file that contains all of the tables.
The issue I have is in the frontend form that handles the logon for the users. The way the access system is set up is the user enters their SSN, then the script finds their SSN in the table and if it exists looks if an access checkbox is checked. If they have access, they're directed to the main menu, if not they get a denied message. What I've found though is for some reason or another, if an entry in the personnel table has an incomplete SSN, the script breaks and anyone can gain access to the database.
There's a query that runs in the frontend that looks at the master personnel table and pulls just the first two columns, SSAN and Access.
The form itself has a visible text box, "Text8", and a hidden Combo Box "Combo4". Combo4 uses the previously mentioned query for the row source (SELECT qryAccess.SSAN FROM qryAccess;), while Text8 is where the user enters their SSN.
Here's the code right now:
Option Compare Database
Private Sub Combo4_AfterUpdate()
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
Private Sub Text8_AfterUpdate()
Me![Combo4] = Me![Text8]
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
Like I said before, as long as every entry for the SSNs is a full 9-digits, this system works. However, if for some reason the entry is not the full 9 like I just found in my database (and no, I have no idea what caused that to happen, there is an input mask in place, 000-00-0000;;_), this system breaks. You could type in "abc" for the SSN and gain access to the database.
How can I write a small script that pre-checks the table for SSN entries that don't fit the 9-digit format that is set, and if it finds them, resets them to an unused number, such as 000000000, 000000001, etc?
Also, if you have any suggestions on how to streamline the existing code, I'd be more than happy to take them.
Add this function to you application
Public Function IsValidSSN(ByVal SSN As String) As Boolean
'Determines if SSN is a valid social security number
'requires SSN to be in either "#########" or "###-##-####" format
IsValidSSN = (SSN Like "###-##-####") Or _
SSN Like ("#########")
End Function
Also change your function to this:
Private Sub Combo4_AfterUpdate()
' Find the record that matches the control.
If IsValidSSN(Me![Combo4]) Then
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
Else
DoCmd.OpenForm "frmDenied"
End IF
End Sub
Private Sub Text8_AfterUpdate()
Me![Combo4] = Me![Text8]
If IsValidSSN(Me![Text8]) Then
' Find the record that matches the control.
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[SSAN] = '" & Me![Combo4] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
If Me![Access] = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
EDIT
Also why are you using a combobox to enter a SSN? You can use input mask on text box. Also I would highly suggest that you convert your system to some other identification other than SSN because it is easily passable to get past this code to look at the table containing everyones SSN, by holding down shift when opening the application. As for streamlining your code just remove that combobox altogether. If they are typing it into a textbox there is no need to put it into a hidden combobox.
You have a text field, SSAN, and with that input mask the dashes are not included in the stored values. So valid values would be 9 digit strings.
If that is correct, you can use a query to identify any invalid stored values.
SELECT y.SSAN, Len(SSAN) AS LenghtOfSSAN
FROM YourTable AS y
WHERE Len(SSAN)<>9 OR y.SSAN ALike '%[!0-9]%';
That query will return rows where SSAN includes < or > 9 characters, and any values which include characters other than digits.
Note the ALike keyword tells the db engine to expect ANSI wild card characters. If you prefer Access' * wild card instead, change it to Like '*[!0-9]*'
Once you fix the stored values, add a Validation rule for that SSAN field (Like "#########") to require all values consist of 9 digits.
Since it looks like this became more of a "How do I find the user" than "How do I fix the existing entries", let me throw my hat into the ring.
Unless I completely misunderstand this, the existing (and accepted answer) function is HORRIBLE. You can do this all much more efficiently and with less code. First of all, delete Combo4. No need for it. Then do this:
Private Sub Text8_AfterUpdate()
Dim X as Integer
X = DLookup("Access", "qryAccess", "SSAN = '" & Me!Text8 & "'")
If Nz(X) = True Then
DoCmd.RunMacro "Access"
Else
DoCmd.OpenForm "frmDenied"
End If
End Sub
That's all you need. If the user's SSN was stored incorrectly, he's gonna be denied. 7 digits, 8 digits, doesn't make a difference. Only exact matches get through. That is, assuming 0 = False and 1 = True, which should be the default anyway.