Access Sign in Module - sql

I'm trying to create a finance database that requires users to sign in and log out. I have that part working correctly. On the homepage of the database, I'm trying to get their last 25 (or X number) of transactions to display using a query. For some reason, I cannot get the code to pass as it shows a "Data type mismatch." Here is the various code - I'll explain each as I go:
Global Variables (My Global Module)
Option Compare Database
'global variables
Global C As Long
Global C2 As Long
Global HoldString As String
Global Flag As Boolean
Global Reply As String
Global mbReply As VbMsgBoxResult
Global User As String
Global GUser As Long
Global db As Database
The following are the Subs() to Log In (First Sub() is for Exit button, second sub() is for sign in button):
Option Compare Database
Private Sub B_Exit_Click()
mbReply = MsgBox(title:="Exit", _
prompt:="Are you sure you wish to exit the system?", _
Buttons:=vbYesNo)
If mbReply = vbNo Then
Exit Sub
Else
DoCmd.Quit acQuitSaveNone
End If
End Sub
Private Sub B_SignIn_Click()
'variables
Set db = CurrentDb()
Dim Employees As DAO.Recordset
Set Employees = db.OpenRecordset("Employees", dbOpenDynaset)
Dim isEmployeed As Boolean
Dim PassMatch As Boolean
Dim isTerm As Boolean
'check to see if the user is in the system
isEmployeed = False
PassMatch = False
isTerm = False
Do While Not Employees.EOF
If Employees![UserName] = T_Username.Value Then
isEmployeed = True
'make sure the employee is not terminated
If Employees![Terminated] = "Yes" Then
isTerm = True
End If
If isTerm = True Then
MsgBox ("This user has been terminated.")
Exit Sub
End If
'make sure password is correct
If Employees![Password] = T_Password.Value Then
PassMatch = True
End If
If PassMatch = False Then
MsgBox ("Incorrect Password.")
Exit Sub
End If
'mark signed in
Employees.Edit
Employees![SignedIn] = 1
Employees.Update
User = Employees![FirstName] & " " & Employees![LastName]
GUser = Employees![ID] 'Sets GUswer to equal record ID.
End If
Employees.MoveNext
Loop
If isEmployeed = False Then
MsgBox ("This username is not in the system.")
Exit Sub
End If
'close this form and open the main menu
Employees.Close
DoCmd.OpenForm FormName:="HomePage"
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
The next is my SQL code for the query:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter, Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total, Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend
WHERE (((Spend.[EnteredBy])="GUser"));
Spend.[EnteredBy] has a relationship with the Employees table. So EnteredBy is actually a number field because of this relationship.
If I hardcode the "WHERE" statement to be something like (((Spend.[EnteredBy])=2)); then the query will work fine.
Ultimately, what I want to happen is for the query to show the last 25 data entries that the logged on user completed.
Hope this makes sense. If there are questions, please let me know. I feel like I'm missing something small but I cannot figure it out.
Thanks,
Clark

Your query should read:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter,
Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total,
Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend WHERE (((Spend.[EnteredBy])=" & GUser & "));
Note the Ampersands ( & ) I placed before and after your GUser variable. This tells Access to evalute that expression and return the VALUE of it.
I'd also caution you against use the name "User" as a variable name. It's a Reserved Word in Access:
http://office.microsoft.com/en-us/access-help/access-2007-reserved-words-and-symbols-HA010030643.aspx

Related

populating multiple fields in subform using combobox and AfterUpdate Event Prodcedure

I am creating a set of Access database form for entering vegetation data into a linked SQL Server data base. For one protocol, I have created a form 'frmLPI' for entering data from a vegetation monitoring method called Line-Point-Intercept. It is a form with a subform within it called 'frmLPIDetail' where individual counts of plant species get recorded. The main form has three unbound controls: [TransectOID], [DataRec], and [DataObs]. TransectOID is a unique id for each time we ran protocol. For each TransectOID, there are 30 locations where we sampled vegetation these have a hidden unique id in the subform called LPI_OID. The subform is linked to the main form by TransectOID. I want my users to be able to click the unbound [DataRec] and [DataObs] comboboxes in the main form, and have the corresponding fields in the subform autopopulate for all 30 records. I have figure out how to accomplish this for record in the subform but can't figure out how to do it for 30 records for each value of TransectOID in the Main form. Below is a screenshot of my form to help you visualize what I am after:
And here is the code I have come up with to get one record to autopopulate
Private Sub Form_Load()
Me.TransectOID = Me.OpenArgs
End Sub
Private Sub Form_Deactivate()
DoCmd.RunCommand acCmdSaveRecord
End Sub
Private Sub DataObs_AfterUpdate()
Me!frmLPIDetail.Form!Data_observer = Me!DataObs
Me.Dirty = False
End Sub
Private Sub DataRec_AfterUpdate()
Me!frmLPIDetail.Form!Data_recorder = Me!DataRec
Me.Dirty = False
End Sub
Any suggestions would be much appreciated
Since inserting multiple records at a time is desirable your question has been asked before but I couldn't find an answer that was particularly helpful so I will provide a more general answer than you asked for.
Access doesn't provide default forms for inserting multiple records. You have to code that yourself but the process is always pretty much the same.
figure out a normalized table structure for your data
figure what data you need to collect from the user for the multiple insert
add a button to the form and put the vba for the multiple insert in the click event
so here is 1 normalized table structure that might fit your data:
Since I don't know where TransectionOID is coming from we let Access provide TransectionID as the primary key and assume TransectionOID is entered on another form. All the other information of interest is in the TransectionDetails table and there is no need to write a query to gather all the variables we will need into our forms record source to finish step 2. To get a jumpstart I selected the TransactionDetails table and used the create form wizard to make a tabular style form.
To finish step 2 we put controls in the header to collect the information from the user we will need and the start editing the form for user friendliness. For instance I delete the checkbox for TransectionDetailID in the details section and replace every other control with comboboxes. I normally replace the circled record selectors with comboboxes as well but here that may be confusing so I leave the record selectors to provide some search functionality. The final form looks like:
Finally, for step 3 we add the vba for the click event
Private Sub cmdInsert_Click()
Dim db As Database
Dim rs As Recordset 'using recordset because lower error rate than using sql strings
Set db = CurrentDb
Set rs = db.OpenRecordset("TransectionDetails")
Dim L As Integer
Dim S As Integer
If Not Me.lstLocations.ListCount = 0 Then 'if no locations are selected no records can be inserted
For L = 0 To Me.lstLocations.ListCount 'simple multiselect listbox version matters for the vba code
If Me.lstLocations.Selected(L) = True Then
For S = 0 To Me.lstSpecies.ListCount
If Me.lstSpecies.Selected(S) = True Then
rs.AddNew
rs!TransectionID = Me.cmbTransectionID
rs!Data_observer = Me.cmbData_observer
rs!Data_recorder = Me.cmbData_recorder
rs!TransectLocation = Me.lstLocations.Column(0, L) 'column gives you access to values in the listbox
rs!SpeciesID = Me.lstSpecies.Column(0, S)
If Not IsNull(Me.chkDead) Then 'chkDead is a triple value checkbox, this both avoids setting Dead to null and shows how to handle when the user doesn't set all controls
rs!Dead = Me.chkDead
End If 'chkdead
rs.Update
End If 'lstspecies selected
Next S
End If
Next L
End If
Me.Detail.Visible = True 'quick and dirty bit of style (detail starts invisible)
Me.Filter = "TransectionID = " & Me.cmbTransectionID 'more quick and dirty style filter to focus on inserted records
Me.FilterOn = True
'clean up
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
Private Sub cmdSelectAllLocations_Click()
Dim i As Integer
For i = 0 To Me.lstLocations.ListCount
Me.lstLocations.Selected(i) = True
Next
End Sub
Private Sub cmdSelectAllSpecies_Click()
Dim i As Integer
For i = 0 To Me.lstSpecies.ListCount
Me.lstSpecies.Selected(i) = True
Next
End Sub
Private Sub cmdSelectNoLocations_Click()
Dim i As Integer
For i = 0 To Me.lstLocations.ListCount
Me.lstLocations.Selected(i) = False
Next
End Sub
Private Sub cmdSelectNoSpecies_Click()
Dim i As Integer
For i = 0 To Me.lstSpecies.ListCount
Me.lstSpecies.Selected(i) = False
Next
End Sub
While Mazoula's answer is far more elegant, I discovered a quick and dirty way to accomplish what I was after using a While loop. Below is my code:
Private Sub Form_Load()
Me.TransectOID = Me.OpenArgs
End Sub
Private Sub Form_Deactivate()
DoCmd.RunCommand acCmdSaveRecord
End Sub
Private Sub DataObs_AfterUpdate()
Dim rs As DAO.Recordset
Set rs = Me!frmLPIDetail.Form.RecordsetClone
rs.MoveLast
rs.MoveFirst
While Not rs.EOF
rs.Edit
rs!Data_observer.Value = Me.DataObs.Value
rs.Update
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Me.Dirty = False
End Sub
Private Sub DataRec_AfterUpdate()
Dim rs As DAO.Recordset
Set rs = Me!frmLPIDetail.Form.RecordsetClone
rs.MoveLast
rs.MoveFirst
While Not rs.EOF
rs.Edit
rs!Data_recorder.Value = Me.DataRec.Value
rs.Update
rs.MoveNext
Wend
rs.Close
Set rs = Nothing
Me.Dirty = False
End Sub

How do I correct a MS Access Run-Time error '2498' in Access VBA?

I am trying to write a code that will print out my current form for the current record. This is what I am using:
Private Sub PrintCommand_Click()
Dim myform As Form
Dim pageno As Long
pageno = Me.CurrentRecord
Set myform = Screen.ActiveForm
DoCmd.SelectObject acForm, myform.Name, True
DoCmd.PrintOut acPages, pageno, pageno, , 1
DoCmd.SelectObject acForm, myform.Name, False
End Sub
When I dimension "pageno" as an integer, it gives me an overflow error for some of my records that exceed 65000. So, I dimensioned it as a long data type, but then I receive the following error:
Run-time error '2498': An expression you entered is the wrong data type for one of the arguments."
I also tried making "pageno" a variant data type, and I received the same 2498 error message. Any suggestions on either a way to fix this or another work around for printing my form for the current record?
Update: This works and accomplishes what I was going for...
Private Sub PrintCommand_Click()
'Print out the current record
Me.Filter = "[Quote Number] = " & QuoteNumberEntry.Value
Me.FilterOn = True
DoCmd.PrintOut
Me.Filter = ""
Me.FilterOn = False
End Sub

Access 2010 - VBA - Editing underlying table data using text boxes on a form

I'm using too many boolean indicators and I'm sure its very inefficient/stupid...
Currently in the Access database I have numerous forms which are used to edit underlying records. Text boxes on these forms are not bound to the underlying table. I do not wish to bind the form or any of its controls directly to the underlying tables, if the data is editable by the user (less human error from users). Instead I've a Boolean for every control which contains editable information.
Users enter 'edit mode', change information (Boolean now equals true), click 'save changes', review the changes and accept and then the relevant queries are run to reflect these changes. I like this order of events however, I'm creating increasingly complex forms with 40 or so editable controls and hence 40 Boolean variables.
Anyone think of an nicer alternative? Is there a property of the controls (mainly text boxes) I can use?
CODE:
Private Sub CommentsText_AfterUpdate()
If Nz(Me.CommentsText) = "" Then
CommentsEdit = False
Else
CommentsEdit = True
End If
End Sub
'Within the 'save changes' method
If CommentsEdit Then
CommentsEdit = False
sql = "Update [General-CN] Set [Comments] = '" & Left(Me.CommentsText, 250) & "' Where [ID ( G )] = " & Me.[GeneralPK] & ";"
DoCmd.RunSQL (sql)
End If
normally data validation during data entry is one the things that normally, in my experience, before or later put the developer on his knees.
From your question, I can feel that the core is to preserve database integrity. Unfortunately there is no way to ABSOLUTELY preserve your database. If you give access to it to users you can only use some tips:
1 - If possible use combo-box with defined entries instead of using textboxes in which user is free to digit anything (e.g. think an expert system that collect data about the same problem written in many different ways!!!)
2 - Check data integrity and coherence (e.g. type) before writing it to database
3 - When the data is just a boolean (flag) you can use switches, radio button or checkboxes.
These tips help in developing a user interface more friendly and faster from the point of view of data entry.
After this I can give you another way to validate your data.
If you want to show data to user before saving you can create the mask in which you enter your data with unbounded textboxes.
Then, when he clicks the Save Button, you can show a 2nd form, opened in append mode, in which you show data with textboxes bounded to your db.
If he accepts the data, you can save otherwise you can cancel the data entry preserving your database. I post you here some lines of code with an example taken from an application of mine. It's the part in which I manage contacts
The form allows to input contact data
'------------------------------------------------------
' Temp variables to store entries before saving /cancelling
'------------------------------------------------------
Dim bolValidationErr As Boolean
Dim m_vntLastName As Variant
Dim m_vntFirstName As Variant
Dim m_vntFC As Variant
Dim m_vntVATNum As Variant
Dim m_vntAddress As Variant
Dim m_vntCity As Variant
Dim m_vntZIP As Variant
Dim m_vntCountry As Variant
Dim m_vntPhone As Variant
Dim m_vntFAX As Variant
Dim m_vntEMail As Variant
Dim m_vntNote As Variant
Dim m_vntContactType As Variant
'------------------------------------------------------
' Suppress error "Impossible to save the record...
'------------------------------------------------------
Private Sub Form_Error(DataErr As Integer, Response As Integer)
If DataErr = 2169 Then
Response = True
End If
End Sub
'------------------------------------------------------
' W/o customer last name, cancel saving
'------------------------------------------------------
Private Sub Form_Beforeupdate(Cancel As Integer)
On Error GoTo Err_Form_BeforeUpdate
Dim strType As String
Dim bolNewContact As Boolean
Dim intErrFC As Integer
Dim intErrVATNum As Integer
Dim intErrFullName As Integer
Dim strErrMsg As String
Dim intAnswer As Integer
bolValidationErr = False
'------------------------------------------------------
' If LastName is missing, cancel data saving
' Cancel = True cause the raise of the error
' "You can't save record at this time..."
' SetWarnings doesn't work. It's needed to intercept with Form_Error event
'------------------------------------------------------
If HasNoValue(Me.txtLastName) Then
strErrMsg = "Put here your error msg"
intAnswer = MsgBox(strErrMsg, vbOKOnly + vbExclamation, "Entry Error")
Cancel = True ' Cancel db update
Call BackupCurrentData ' Store data input until now
bolValidationErr = True ' Unvalid data
Exit Sub
End If
Exit_Form_BeforeUpdate:
Exit Sub
Err_Form_BeforeUpdate:
GoTo Exit_Form_BeforeUpdate
End Sub
'------------------------------------------------------
' Store the content of textboxes for restoring them in case
' of cancelling
'------------------------------------------------------
' If the record is new, if the BeforeUpdate event is cancelled,
' NULL values are restored (in fact there were no data!!!)
'------------------------------------------------------
Private Sub BackupCurrentData()
m_vntLastName = Me.txtLastName
m_vntFirstName = Me.txtFirstName
m_vntFC = Me.txtFC
m_vntVATNum = Me.txtVATNum
m_vntAddress = Me.txtAddress
m_vntCity = Me.txtCity
m_vntZIP = Me.txtZIP
m_vntCountry = Me.txtCountry
m_vntPhone = Me.txtTelNum
m_vntFAX = Me.txtFax
m_vntEMail = Me.txtEmail
m_vntNote = Me.txtNotes
m_vntContactType = Me.cmbContactType
End Sub
'------------------------------------------------------
' Restore contents of textboxes before cancelling operation
'------------------------------------------------------
Private Sub RestoreCurrentData()
Me.txtLastName = m_vntLastName
Me.txtFirstName = m_vntFirstName
Me.txtFC = m_vntFC
Me.txtVATNum = m_vntVATNum
Me.txtAddress = m_vntAddress
Me.txtCity = m_vntCity
Me.txtZIP = m_vntZIP
Me.txtCountry = m_vntCountry
Me.txtTelNum = m_vntPhone
Me.txtFax = m_vntFAX
Me.txtEmail = m_vntEMail
Me.txtNotes = m_vntNote
Me.cmbContactType = m_vntContactType
End Sub
I think that this code can be adapted to your needs.
The variable names are enough self-describing
Anyway feel free to contact me if you need further help.
Bye,
Wiz:-)

Using a swear word filter with InStr in Visual Basic 2012

I want to compare the IF argument to a string array. The user will try to put in a teamname into a textbox, if the user uses a swear word anywhere within that textbox, it will display an error message and clear the textbox. If the user has not sworn, it will register the teamname and carry on with the program (As can be seen in the 2nd IF statement). I have tried to get this code to work for a week now and cannot get it to work.
Private Sub SelectionButtonEnter_Click(sender As Object, e As EventArgs) Handles SelectionButtonEnter.Click
Dim HasSworn As Boolean = False
Dim swears() As String = {"Fuck", "fuck", "Shit", "shit", "Shite", "shite", "Dick", "dick", "Pussy", "pussy", "Piss", "piss", "Vagina", "vagina", "Faggot", "faggot"} 'Declare potential swear words the kids can use
For Each swear As String In swears
If InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
SelectionTextBoxTeamName.Clear() 'Clear the textbox
MessageBox.Show("Remember ... You can be disqualified, raise your hand and Blair will set up the program for you again") 'Let the user know they have entered a swear word and ask them to select another team name
End If
If Not InStr(SelectionTextBoxTeamName.Text, swear) > 0 Then
Timer1.Enabled = True 'Enable timer 1 for the learn box
Timer3ForSelection.Enabled = True 'Enable this timer to show the learn button
TeamName = SelectionTextBoxTeamName.Text() 'Once this button has been pressed, store the content of that textbox in a the TeamName string
SelectionLabelTeamName.Text = "Welcome " & SelectionTextBoxTeamName.Text & " Please click 'Learn' in the box below to begin" 'Display the contents of the string along with other text here
SelectionLabelTeamNameTL.Text() = "Team Name: " & TeamName 'Display the contents of the string along with other text here
SelectionTextBoxTeamName.BackColor = Color.Green 'Have the back color of the box set to green
SelectionTextBoxTeamName.Enabled = False 'Do not allow the user/users enter another team name
End If
Next 'A next must be declared in a for each statement
End Sub
Thanks in advance.
I don't think I'd approach it that way; if the user types f**kyou, your code wouldn't catch it. How about this instead:
In your code:
If ContainsBannedWord(SelectionTextBoxTeamName.Text) Then
Msgbox "Hold out your hand, bad person. SlapSlapSlap"
Else
Msgbox "Good boy!"
End if
Function ContainsBannedWord(sInput As String) As Boolean
Dim aBannedWords(1 To 5) As String
Dim x As Long
' Make all the banned words capitalized
aBannedWords(1) = "BANNED1"
aBannedWords(2) = "BANNED2"
aBannedWords(3) = "BANNED3"
aBannedWords(4) = "BANNED4"
aBannedWords(5) = "BANNED5"
For x = LBound(aBannedWords) To UBound(aBannedWords)
If InStr(UCase(sInput), aBannedWords(x)) > 0 Then
ContainsBannedWord = True
Exit Function
End If
Next
ContainsBannedWord = False
End Function

Exit main sub procedure if called sub is false

I have a 'protection' sub procedure Sub unprot_manually() which can been seen below. I have another sub procedure which could be refereed to as the main procedure of the workbook. I would like to call this protection procedure prior to allowing the user to run the main procedure. With my current code below, the user is able to run the main procedure regardless of entering the correct password. Do I need to create a 'protection' function, define as Boolean, and then pass as a parameter to the main sub?
Sub unprot_manually()
Dim password_input
Dim Pass As String
Application.ScreenUpdating = False
Pass = "xxxxxx"
password_input = Application.InputBox("Password", "Awaiting User Input..")
If password_input = Pass Then
Call Unprot
'Else
'MsgBox ("Incorrect, Good Bye")
'MsgBox ("Incorrect")
End If
Application.ScreenUpdating = True
End Sub
change it from a Sub to a Function, and then check the return value.
e.g. in your main procedure,
if unprot_manually then
rest of program
else
msgbox "Incorrect Passowrd"
end if
your other section would then become:
Function unprot_manually() as Boolean
'set to fail condition until we get a success status
unprot_manually=False
...
If password_input = Pass Then
Call Unprot
'passed, so set success condition
unpot_manually=True
End If
...
End Function
Creating a UDF to do a simple string comparison is a bit OTT. You don't even need a separate procedure for this, just put the If block in your main procedure
Sub Unprot()
If Application.InputBox("Password", "Awaiting User Input..") = "xxxxxx" Then
' Rest of code here
Else
MsgBox "Incorrect Password!"
End If
End Sub
Even better than this, just set the worksheet protection with the UserInterfaceOnly option set to true, then the user can't make any changes on the front end, but your code can still run without obstruction.
UPDATE: (In response to comment)
Just use a variable and check the input:
Sub Unprot()
Dim tempStr As String
tempStr = InputBox("Password", "Awaiting User Input..") ' Assign value via input
If tempStr = vbNullString Then Exit Sub 'If no input, exit sub
If tempStr = "xxxxxx" Then
'Rest of Code
Else
MsgBox "Incorrect Password!"
End If
End Sub