I'm trying to figure out the best way to have my checkbox "checked" when my user clicks Yes when validating approvals. The checkbox column lives in the retailEntry table but I added it to my approval query so they should be linked.
The problem is that all "pack_numbers" are checked even the ones not present on the approval query. I want only the packs that appear on the approvalqry to be checked. It appears I cannot "Check" the "Creative Approval" from the approvalqry and if I use the retailentry recordset it just checks everything.
Any advice or push in the right direction would be greatly appreciated!
Code:
Set rap = CurrentDb.OpenRecordset("Approvalqry")
Set rs = CurrentDb.OpenRecordset("RetailEntry")
On Error Resume Next
If Not (rap.EOF And rap.BOF) Then
rap.MoveFirst
Do Until rs.EOF = True
If rap.RecordCount > 0 Then
nConfirmation = MsgBox("PackNumber " & rap.Fields("Pack_Number") & " Offer " & rap.Fields("Catid") & " is currently in the Proofing Stage, and will require Approval from CMS - Creative, and Divisional Merch Manager. Confirm Approvals have been received?", vbInformation + vbYesNo, "Approval Required!")
If nConfirmation = vbYes Then
'Update approved checkbox
If rap.Fields("Pack_Number").Value Then
rap.Edit
rap![Creative Approval] = True
rap.Update
Else
End If
Else
MsgBox "Please obtain Late Retail Change Approval for this product within Offer " & rap.Fields("Catid") & ", then resubmit your request."
ClearTables
End
End If
End If
rap.MoveNext
rst.MoveNext
rs.MoveNext
Me.Requery
Loop
End If
On Error GoTo 0
Err.Clear
Related
This code is for a login form I have setup to enter the front end copy of a database. In one database it works like a charm. I imported the form and corresponding objects to another database and it appears to be not recognizing my password when I enter it. I just keep getting the message box I have popping up that says, "Incorrect password". Any help figuring this out would be greatly apprecaited.
The SQL statement that drives the cboUser combo box on the login form is:
SELECT tblUser.UserID, [FName] & " " & [LName] AS Fullname,
tblUser.Password, tblUser.PWReset, tblUser.AccessLevelID
FROM tblUser ORDER BY tblUser.LName, tblUser.FName;
.
Private Sub OkBTN_Click()
Static intIncorrectCount As Integer
Dim AuthorityNumber As Integer
'Dim rs As Recordset
'TempVars("Username") = Me.cboUser.Value
'Column references for cbouser row source reference
'UserID = 0
'FullName = 1
'Password = 2
'PWReset = 3
'AccessLevelID = 4
'Set rs = CurrentDb.OpenRecordset("UserNameQuery", dbOpenSnapshot)
'N = Nz(DLookup("Fullname", "UserNameQuery", "Fullname=""" & Me.cboUser & """"), " ")
'Check that User is selected
If IsNull(Me.cboUser) Then
MsgBox "You forgot To Select your name from the drop down menu!", vbCritical
Me.cboUser.SetFocus
Else
'Check for correct password
If Me.txtPassword = Me.cboUser.Column(2) Then
'Check if password needs to be reset
If Me.cboUser.Column(3) Then
DoCmd.OpenForm "frmPasswordChange", , , "[UserID] = " & Me.cboUser
End If
Me.Visible = FALSE
intIncorrectCount = 0
'Main menu after correct login based on AuthorityNumber
If Me.cboUser.Column(4) = 5 Then
DoCmd.OpenForm "SRL1MainMenu"
'Forms!AMSReportForm!L2Menubtn.Visible = False
Forms!SRL1MainMenu!FullNameLoggedIn = Forms!frmLogin!cboUser.Column(1)
Else
DoCmd.OpenForm "L2MainMenu2"
'Forms!AMSReportForm!L2Menubtn.Visible = True
Forms!L2MainMenu2!FullNameLoggedIn = Forms!frmLogin!cboUser.Column(1)
End If
'Failed login attempt limitation
ElseIf intIncorrectCount > 1 Then
MsgBox "Too many failed login attempts. Click OK To Set New password", vbOK + vbExclamation
DoCmd.OpenForm "frmPasswordChange", , , "[UserID] = " & Me.cboUser
'DoCmd.Close acForm, "frmLogin"
Else
MsgBox "Incorrect password", vbOKOnly + vbExclamation
Me.txtPassword = Null
Me.txtPassword.SetFocus
intIncorrectCount = intIncorrectCount + 1
End If
End If
End Sub
First, #Andre is probably right - you may have to apply brackets to "Password".
Next, this may not perform a case sensitive comparison:
If Me.txtPassword = Me.cboUser.Column(2) Then
Use StrComp to do that:
If StrComp(Me!txtPassword.Value, Me!cboUser.Column(2), vbBinaryCompare) = 0 Then
Finally, you should never store plain passwords; store a hash value instead. It isn't that difficult, if you study my latest article:
Storing passwords in VBA using the Microsoft NG Cryptography (CNG) API
I am having a problem when an user decides to "clear/delete" a line entered on the form during the first update.
I have a form with a subform to give the user the possibility of multiple entries, however, after the user has first edited any field on the subform the respective record gets dirty and recorded, so if the user decides to not use anymore that record and deletes all the info for that line, that line which now is all blank still being recorded, and this is giving me blank lines in my data (The TransactionID and ID are not shown to the user on the form, I added it for the sake of this post).
This can also accidentally happen if on the "new" line, which is not dirty, the user hits any key by mistake, and even deleting it straight away, the record gets dirty for good, so it ends being recorded completely in blank.
I couldn't find a way to avoid recording this blank lines.
I would like to know if it is possible to have buttons to "add a new line" and "delete a line", just like, on the last line it would have a "+" to add new line (so the "new not dirty" line wouldn't appear automatically), and on the precedent lines would have a "-" to remove that specific record (this is just an idea, it can be in any kind of way).
Is that achievable? If it is not, is there a way to simply avoid blank lines to be saved? Like, saving jumping those blank lines, just like in a loop?
More information added for the sake of better explanation.
I didn't include the code before as there is no code behind this, this is just access natural recording set. I am not using DAO Record Set nor SQL to "save" the records (just to delete from table in a discard event), I am using normal bounded controls.
The modifications I did were on Parent form to always stay on the Current Record (Cycle) and On Load event it always goes to new record. Thus, the buttons Save and Cancel, are used to confirm or discard the new record created on the Parent form, because, as I have previously said, the subform is used to enter multiple records under the same record on the Parent Table, in other words, Relationship One-To-Many, therefore the button "Close" holds a simple code for deleting the last entry on the Parent Table (as it still on the current record) and as the tables have "Delete Cascade Relationship" all the information entered into the subform/Child Table get automatically deleted, so I just had to handle the data inserted into the Parent Table, whereas, the save button is used to get the confirmation of saving from the user, and make sure that the user will fill all the fields prior to save.
That is pretty much the code on this form, which is below.
But before the code, I would like to reinforce that, I have made use of the "BeforeUpdate" event, which works fine, it makes the user to add all the fields before opening a new record on the subform, but let's suppose that the user enters 10 records on the subform, then the user decides to "Delete" one of the records (which in this case is not the last one, so he cannot just press "ESC" and I cannot just run "Me.Undo"), so if the user clears the fields (just like in the images I have provided, as I don't know how to delete a record in this scenario yet), the before update event gets triggered and doesn't allow the user to do anything while he/she fills in the blank fields, not even to click in "Cancel". Therefore, in my "Save" button I check all the fields and if one of them is "dirty" them the user must fill all the subsequent fields, however, if all the fields are "empty", the user is still able to save.
In the beginning I thought that those "blank lines" wouldn't happen so often and I would have to clean them sporadically, but it is unbelievable, the amount of blank lines that have been created by the users. I have to clean them almost every week.
I really would like a way to create "+ add line" and "- delete line" buttons, because if the user wants to delete a line he just click on "-" button, the same for add new line.
Again, I appreciate the help. I am really struggling on this. Thanks all.
Private Sub btnSave_Click()
If IsNull(Me.TransactionDate) _
And IsNull(Me.SupplierPayee) _
And IsNull(Me.TotalReceipt) Then
MsgBox "Form in blank!", vbInformation + vbOKOnly, "Saving..."
Exit Sub
End If
If IsNull(Me.TransactionDate) _
Or IsNull(Me.SupplierPayee) _
Or IsNull(Me.TotalReceipt) Then
MsgBox "Please fill in all the fields", vbCritical + vbOKOnly, "Transaction not Saved"
Exit Sub
End If
Me![subfrmPCHeaderDetail].SetFocus
DoCmd.GoToRecord , , acFirst
If IsNull(Me.TransactionDate) _
Or IsNull(Me.SupplierPayee) _
Or IsNull(Me.TotalReceipt) _
Or IsNull(Form_frmPCHeaderDetail.Item) _
Or IsNull(Form_frmPCHeaderDetail.ItemAmount) _
Or IsNull(Form_frmPCHeaderDetail.VATRate) _
Or IsNull(Form_frmPCHeaderDetail.DescriptionPurpose) Then
MsgBox "Please fill in all the fields", vbCritical + vbOKOnly, "Transaction not Saved"
Exit Sub
ElseIf Form_frmPCHeaderDetail.ItemAmount = "0" Then
MsgBox "Amount cannot be €0.00", vbCritical + vbOKOnly, "Transaction not Saved"
Form_frmPCHeaderDetail.ItemAmount.SetFocus
Exit Sub
End If
If Not Me.TotalReceipt.Value = Form_frmPCHeaderDetail.GrossTotal _
Or IsNull(Me.TotalReceipt) Then
MsgBox "Please check the Receipt Amount Details as ""Gross Total"" and ""Receipt Total"" are not matching"
Exit Sub
End If
If Me.ReceiptScanned.AttachmentCount = 0 Then
MsgBox "Please scan the receipt and add it to this transaction", vbInformation + vbOKOnly, "Add the Receipt"
Me.AddReceiptScanned.SetFocus
Exit Sub
End If
If Me.TransactionDate > Date Then
MsgBox "Future Transaction Date not allowed", vbCritical + vbOKOnly, "Transaction not Saved"
Me.TransactionDate.SetFocus
Exit Sub
Else
Dim Result As Long
Result = MsgBox("Saving Transaction!" & vbNewLine & vbNewLine & _
"Attention!" & vbNewLine & vbNewLine & _
"You will not be able to delete nor modify any detail of this transaction!" & vbNewLine & vbNewLine & _
"Are you sure you would like to save this transaction?" & vbNewLine & vbNewLine & _
"Click ""YES"" to save, or click ""NO"" to return.", vbExclamation + vbYesNo, "Save Transaction?")
If Result = 6 Then
DoCmd.Save
DoCmd.Requery
Form_frmPCHeader.TransactionDate.SetFocus
DoCmd.GoToRecord , , acNewRec
MsgBox "Transaction added successfully to the Petty Cash Register", _
vbInformation + vbOKOnly, "Petty Cash transaction added"
End If
End If
End Sub
Private Sub btnClose_Click()
Dim LastID As Long
Dim Result As Long
If IsNull(TransactionID) Then
DoCmd.Close
Exit Sub
End If
LastID = TransactionID
MsgBox("Closing without saving!" & vbNewLine & vbNewLine & _
"If you want to discard the entries, click ""YES"", or click ""NO"" to return.", vbCritical + vbYesNo, "Discard Entries?")
If Result = 6 Then
Application.Echo False
Me.Painting = False
DoCmd.SetWarnings False
Me.TransactionDate = "31/12/2099"
Me.SupplierPayee = "Discarded"
Me.TotalReceipt = 0
DoCmd.Save
DoCmd.Requery
DoCmd.RunSQL "DELETE * FROM tblPCHeader WHERE TransactionID = " & LastID & ""
DoCmd.Close
Application.Echo True
DoCmd.SetWarnings True
End If
End Sub
Private Sub Form_Load()
DoCmd.GoToRecord , , acNewRec
End Sub
For a Delete (-) button, consider code:
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdDeleteRecord
DoCmd.SetWarnings True
For Add (+) button, just move to new record row with code you already know.
Docmd.GoToRecord , , acNewRec
I'm currently building a form where a user can look up a tool based on the description or part number.
I want user to be able to type any letters into the combobox that I have tied to a query listing all my tools and the combobox will repopulate itself with the tools most similar to what is present in their combobox. For example, if they start typing wre, then tools that have similar characters will start appearing in the combobox such as wrench, torque wrench, power wrench, etc.
I've tried looking around for other people's solutions to this but either I didn't fully comprehend the existing solution (I'm fairly new to Access) or it wasn't what I was looking for. I've seen that people suggested using a listbox instead but I really don't want to go down that route.
I was thinking about using what the user types in the combobox and my VBA code will pick up the "change event" and requery the combobox on the fly by using their input as the like criteria for the new query.
Is this a possible route? Will it be slower? Is there a better route?
I'm hoping someone can show some examples on how to achieve what I'm looking for.
The search as you type feature is very useful! With a textbox and a listbox, you can setup a dynamic search tool that will filter a list for approximate matches as you type. The textbox has four events associated with it, as seen here.
The code behind the form looks like this. Pay attention to the part in bold. This is where we create a string of SQL commands, and utilize the SQL Like operator, to get dynamic matches as we type. Pay attention to the text in bold below.
Option Compare Database
Option Explicit On
Private blnSpace As Boolean 'INCLUDE THIS LINE ON YOUR FORM
Private Sub btnClearFilter_Click()
'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
On Error Resume Next
Me.txtSearch.Value = ""
txtSearch_Change()
End Sub
Private Sub txtSearch_Change()
'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
Dim strFullList As String
Dim strFilteredList As String
If blnSpace = False Then
Me.Refresh 'refresh to make sure the text box changes are actually available to use
'specify the default/full rowsource for the control
strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"
'specify the way you want the rowsource to be filtered based on the user's entry
strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
"*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"
'run the search
fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
'IN WHICH CASE WE WANT TO IGNORE THE INPUT
On Error GoTo err_handle
If KeyAscii = 32 Then
blnSpace = True
Else
blnSpace = False
End If
Exit Sub
err_handle:
Select Case Err.Number
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
End Select
End Sub
Private Sub txtSearch_GotFocus()
' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
On Error Resume Next
If Me.txtSearch.Value = "(type to search)" Then
Me.txtSearch.Value = ""
End If
End Sub
Private Sub txtSearch_LostFocus()
' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
On Error Resume Next
If Me.txtSearch.Value = "" Then
Me.txtSearch.Value = "(type to search)"
End If
End Sub
Finally, in a regular module, you will need this script.
Option Compare Database
Option Explicit On
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software http://www.opengatesw.net
Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search
On Error GoTo err_handle
'restore the cursor to where they left off
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
If ctlSearchBox.Value <> "" Then
'Only fire if they've input more than two characters (otherwise it's wasteful)
If Len(ctlSearchBox.Value) > iSensitivity Then
ctlFilter.RowSource = strFilteredSQL
If ctlFilter.ListCount > 0 Then
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
Else
If blnEmptyOnNoMatch = True Then
ctlFilter.RowSource = ""
Else
ctlFilter.RowSource = strFullSQL
End If
End If
Else
ctlFilter.RowSource = strFullSQL
End If
Else
ctlFilter.RowSource = strFullSQL
End If
'if there is a count label, then update it
If IsMissing(ctlCountLabel) = False Then
ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
End If
Exit Function
err_handle:
Select Case Err.Number
Case 91 'no ctlCountLabel
'exit
Case 94 'null string
'exit
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
End Select
End Function
The code comes from this link:
http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html
The Basic Function of this is that when you Log in to the system and when on load of the Main Menu it should show a message if certain Products have reached the critical level and when you press yes it should redirect to the form where it shows a detailed view.
In this Case the Quantity in hand is "QTY" and Critical Level is "ROQ" (Field names in the tblProduct)
Dim Alert As Integer
Dim rsAlert As New Adodb.Recordset
rsAlert.Open "select * from tblproduct , CurrentProject.Connection"
Alert = DCount("[qty]", "[tblProduct]", " [ROQ] <= Qty and =0")
If Alert = 0 Then
Exit Sub
Else
If MsgBox("This/These " & Alert & " product/products have reached their critical levels" & _
vbCrLf & vbCrLf & "Would you like to see these now?", _
vbYesNo, "Alert...") = vbYes Then
DoCmd.Minimize
DoCmd.OpenForm "frmAlerts", acNormal
Else
Exit Sub
End If
End If
End Sub
The error I get is that when load my menu menu it doesn't show the number of products which are under the critical level ! If anyone can help it would be a Great Help!
This has been done in Microsoft Access.
Further to my comment this is a not going to work. Create a list box and populate it with the stock shortages, something like this;
Dim rsAlert As Recordset
Dim sSql As String
sSql = "SELECT ProductID, Description, OtherFields, GoHere FROM tblproduct WHERE ROQ >= QTY AND ROQ > 0"
Set rsAlert = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)
If Not rsAlert.EOF Then 'There are records (shortages) so unhide and poulate the list box (called lstShortageListBox)
Me.lstShortageListBox.Visible = True
Me.lstShortageListBox.RowSource = sSql
Else
Me.lstShortageListBox.Visible = False
End If
' Tidy Up
rsAlert.Close
Set rsAlert = Nothing
Obviously make sure that the recordsets criteria are correct - I've made some guesses about that bit.
I have the below code where I'm trying to check comboboxes to make sure they are not null
I have a core combobox - cmbHierarchy - with Store, Retailer, Territory, District and secondary comboboxes to select stores, retailers, territories, districts (one for each)
I want the VBA to check cmbHierarchy to make sure it's populated, then depending on what it is populated with, make sure it's corresponding combobox has a value selected.
The current code is checking to make sure all 5 are populated. Where what I need is if cmbHierarchy = store then check cmbStore, if cmbHierarchy = retailer then check retailer, and so on.
Private Sub btnQryTermCount_Click()
Dim strQueryName As String
If Me.cmbHierarchy.Value = Store Or IsNull(Me.cmbStore.Value) Then
MsgBox "Please choose a Store"
Me.cmbStore.SetFocus
ElseIf Me.cmbHierarchy.Value = Retailer Or IsNull(Me.cmbRetailer.Value) Then
MsgBox "Please choose a Retailer"
Me.cmbRetailer.SetFocus
Else: strQueryName = "TERM_Count_" & Me.cmbHierarchy
MsgBox "Query Ready: " & strQueryName
DoCmd.OpenQuery strQueryName
End If
End Sub
Any help would be greatly appreciated.
Thanks!
Since your controls are named conveniently, you can do something like this:
If Nz(Me.cmbHierarchy.Value, "") <> "" Then
If Nz(Me.Controls("cmb" & Me.cmbHierarchy.Value).Value) = "" Then
MsgBox "Please choose a " & Me.cmbHierarchy.Value & "."
Else
strQueryName = "TERM_Count_" & Me.cmbHierarchy.Value
MsgBox "Query Ready: " & strQueryName
DoCmd.OpenQuery strQueryName
End If
Else
'cmbHierarchy validation failed logic here.
End if
IsNull instead of Nz maybe fine, but I am always in the habit of casting the value to be safe.