I have an MS Access database where I'm using the Before_Update() command to ensure prevent a user from pasting in data that doesn't match a specific validation list. Using Before_Update() I check against the list and cancel the entry if the value doesn't match, as well as popping up an error message. However, this cancellation re-triggers the Before_Update() which causes the message to come up again, which is very annoying. I'm stumped on a reliable way to remove the duplicate
Private Sub ProductClass_BeforeUpdate(Cancel As Integer)
Dim strSQL As String
Dim RS As DAO.Recordset
strSQL = "select * from pGroupList where (ProductClass) = '" & Me.ProductClass & "';"
Set RS = CurrentDb.OpenRecordset(strSQL)
If RS.EOF Then
MsgBox "Invalid Entry - Product Group", vbOKOnly, "Invalid Entry"
Cancel = True
End If
RS.Close
Set RS = Nothing
End Sub
Related
I'm trying to put together a quick way of sending multiple records for print in one go..
To achieve it I put together a query [Qry_Mass_Print] rounding up job card numbers [Job Number] with a yes/no field indicating if the record should be printed [PrntJbSwtch]
In VBA using the watch list the below code appears to be counting the correct number of records so I believe the look up is working but I can't seem to extract the job number while looping through to assign to the print string variable PRNTstr
Private Sub MssJbCrdPrnt_Click()
On Error GoTo ErrorHandler
Dim PRNTstr As String
Dim strSQL As String
Dim rs As DAO.Recordset
strSQL = "SELECT 'Job Number' FROM Qry_Mass_Print WHERE [PrntJbSwtch] = True"
Set rs = CurrentDb.OpenRecordset(strSQL)
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
'' MsgBox (!Job_Number)
PRNTstr = !Job_Number
DoCmd.OpenReport "JobCard", acNormal, , PRNTstr
.MoveNext
Wend
End If
.Close
End With
ExitSub:
Set rs = Nothing
Exit Sub
ErrorHandler:
Resume ExitSub
End Sub
I think its the retrieving the Job Number causing the issue as I can't even get it to show in a msgBox...
Any suggestions on what's causing it?
Rather than the SQL string being:
strSQL = "SELECT 'Job Number' FROM Qry_Mass_Print WHERE [PrntJbSwtch] = True"
You should wrap the field name in square brackets:
strSQL = "SELECT [Job Number] FROM Qry_Mass_Print WHERE [PrntJbSwtch] = True"
You may also want to put an ORDER BY in the SQL string.
.. and to adjust the code accordingly:
PRNTstr = ![Job Number].Value
Regards,
Alright, short background, I have a form, on which I have 3 Comboboxes.
Two of these comboboxes are tied to the same exact table, an accounts table. They use slightly different queries between them, see below.
In one box, cmb_GA I have set the box property "On Not in List" to the following code segment :
Private Sub cmb_GA_NotInList(NewData As String, Response As Integer)
Dim cnn As New ADODB.Connection
Dim strSQL As String
Dim password As String
Dim bytUpdate As Byte
On Error GoTo ErrHandler
Set cnn = CurrentProject.Connection
bytUpdate = MsgBox("Do you want to add " & NewData & " to the Accounts list?", vbYesNo, "Not in list of Accounts!")
If bytUpdate = vbYes Then
password = InputBox("Enter New Account Password")
strSQL = "INSERT INTO tbl_Accounts(Login, PW) " & "VALUES
('" & NewData & "#mcsnet.org' , '" & password & "')"
Debug.Print strSQL
cnn.Execute strSQL
Response = acDataErrAdded
Call AuditLogs("txt_DN", "New")
ElseIf bytUpdate = vbNo Then
Response = acDataErrContinue
Me!cmb_GA.Undo
End If
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Error"
End Sub
Note that for formatting here I put in an extra CR after "VALUES" that doesn't exist in the actual code, other than that, and some deleted comments, WYSIWIG.
This code works perfectly. 100% Does what I want.
I have another combobox, cmb_IA
I am using the same code for it (Yeah I probably should have done this as a module in retrospect, but I didn't yet.)
The problem is that it throws an error. "The text you entered isn't an item in the list. Select an Item from the list, or enter text that matches one of the listed items."
I've looked at the properties and can not find a difference between the two boxes on the property sheets: Here's a look at both boxes Data tab:
And here is the relevant SQL from the two queries:
SELECT *
FROM tbl_Accounts
WHERE tbl_Accounts.Association LIKE "*Device*";
and
SELECT *
FROM tbl_Accounts
WHERE tbl_Accounts.Association LIKE "*Intune*";
I would assume the question is obvious, but let me state this outright, what is happening here? Is there a way to suppress this error? Both comboboxes must let the user add new information to them, as the point of this form is to register new devices, cellphones and tablets, and the security accounts and corporate accounts that each device uses. What's puzzling me the most is that this error is only showing up on the one combobox.
Edited to add the code from the section that is throwing the error:
Private Sub cmb_IA_NotInList(NewData As String, Response As Integer)
Dim cnn As New ADODB.Connection
Dim strSQL As String
Dim password As String
Dim bytUpdate As Byte
On Error GoTo ErrHandler
Set cnn = CurrentProject.Connection
bytUpdate = MsgBox("Do you want to add " & NewData & " to the Accounts list?", vbYesNo, "Not in list of Accounts!")
If bytUpdate = vbYes Then
password = InputBox("Enter New Account Password")
strSQL = "INSERT INTO tbl_Accounts(Login, PW) " & "VALUES ('" & NewData & "#mcsnet.org' , '" & password & "')"
Debug.Print strSQL
cnn.Execute strSQL
Response = acDataErrAdded
Call AuditLogs("txt_DN", "New")
ElseIf bytUpdate = vbNo Then
Response = acDataErrContinue
Me!cmb_IA.Undo
End If
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Error"
End Sub
It was suggested I show the RowSource SQL generated by Access so here it is Working:
SELECT qry_DeviceAccounts.AccountIDKey, qry_DeviceAccounts.Login, qry_DeviceAccounts.PW
FROM qry_DeviceAccounts
ORDER BY qry_DeviceAccounts.[Login];
Not Working:
SELECT qry_SecurityAccounts.AccountIDKey, qry_SecurityAccounts.Login, qry_SecurityAccounts.PW
FROM qry_SecurityAccounts
ORDER BY qry_SecurityAccounts.[Login];
I can't believe I didn't see it earlier. This was the result of the difference between the two queries, and the way they filtered for the account information. I needed to set the new account information to be filtered for during the INSERT statement, which hadn't been done. Since the other one worked on the default value of one of the fields in the table, it wasn't relevant to that one's INSERT statement.
Moral of the story, check your fields, and make sure you carefully read what each is doing. I was so busy looking for an error in my VBA, I forgot to check my SQL.
I'm attempting to write a function that compares the "Pack_Number" fields in two recordsets. My code works fine if they are in numerical order but if pack numbers are added out of order my code doesn't work right and won't recognize that the pack numbers exist.
My Code:
Function Validation()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsm As DAO.Recordset
Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("RetailEntry")
Set rsm = CurrentDb.OpenRecordset("MasterQuery")
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate offers have not mailed
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
If rsm.RecordCount = 0 Or rs.Fields("Pack_Number") <> rsm.Fields("Pack_Number") Then
MsgBox ("All prefixes have mailed for Pack Number " & rs.Fields("Pack_Number") & " If you wish to submit an In-season Markdown Request " _
& "please exit the tool, and submit your request using the In-Season Markdown request file in the CID Request folder")
Exit Function
rs.MoveNext
rsm.MoveNext
Loop
End If
End Function
What I'm trying to do is just have it verify that the pack number they entered from RetailEntry is appearing in the MasterQuery if it is then pass else fail and msgbox pops up.
Any help would be greatly appreciated.
I get a Runtime Error 15 on the following line:
MyuserID = Me.txtfirstname.Value from the code below:
Option Compare Database
Option Explicit
Private Sub cmdchange_Click()
On Error Resume Next
If Trim(Me.txtnewpass & "") <> Trim(Me.txtconfirmpass & "") Then
MsgBox "Passwords do not match", vbExclamation + vbOKOnly, ""
Me.cmdchange.Enabled = False
Else
Me.cmdchange.Enabled = True
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Select' From[User Registration Details] where [UserID]=" & MyuserID)
If Not rs.EOF And Not rs.BOF Then
rs.Edit
rs("Password") = txtconfirmpass
rs.Update
rs.Close
Set rs = Nothing
MsgBox "Your Password has been successfully changed", vbInformation, "Electporl"
DoCmd.Close acForm, "frmnewpassword", acSaveNo
DoCmd.OpenForm "frmlogin"
End If
End If
Given that I placed the code below on the button that takes the user to the changing password form.
Private Sub cmdproceed_Click()
If IsNull(Me.txtfirstname) Or Me.txtfirstname = "" Then
Me.mand1.Visible = True
Me.txtfirstname.SetFocus
End If
If IsNull(Me.txtemail) Or Me.txtemail = "" Then
Me.mand2.Visible = True
Me.txtemail.SetFocus
End If
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("User Registration Details", dbOpenSnapshot, dbReadOnly)
rs.FindFirst ("Firstname='" & Nz(Me.txtfirstname, "") & "'")
If rs.NoMatch = True Then
Me.lbl1.Visible = True
Me.txtfirstname.SetFocus
Exit Sub
End If
If rs!Username <> Nz(Me.txtemail, "") Then
Me.lbl2.Visible = True
Me.txtemail.SetFocus
Exit Sub
End If
'MyuserID is publicly declared as Long in a module
MyuserID = Me.txtfirstname.Value
DoCmd.OpenForm " frmnewpassword"
DoCmd.Close acForm, Me.Name
End Sub
the second code is assigned to the button that redirects the user to the form that will enable him or her change the password after verifying his or her first name and email.
The second one now is assigned to the button that will help the user change the password by overwriting the old password.
Please pass the UserID value in your procedure.
In your cmdproceed_Click() procedure update the following section:
'MyuserID is publicly declared as Long in a module
MyuserID = rs("UserID")
In your cmdchange_Click() procedure update the following line:
Set rs = CurrentDb.OpenRecordset("Select * From [User Registration Details] where [UserID]=" & MyuserID)
From a logical point of view, you can have others with the same firstname, so doing the filter on the firstname only will introduce unexpected behaviors later in the life cycle of your application.
If you have two or more users with the first name 'Joshua' then your code will always select the first user with that first name. You need to update this logic to select a unique user.
I am seeking one suggestion on how to build an excel macro for below requirement. Request you to provide your valuable comments in EXCEL Only.
Scenario
I have one spreadsheet "Product Master" that contains all the product details.
(i.e. Product ID,Product Name,Product Type,Quantity etc etc)
I am designing a UserForm using excel VBA where anyone can fetch all the details of a product based on its Product ID. Now the product-master sheet where all the product details is present will get updated on a daily basis. And each user should be able to update any details in that sheet based on his requirement.
Questions/Doubts
How do I design my system? I mean where should I put my "Product-Master" spreadsheet so that it can be accessed by multiple users. What I am thinking is to put product-masster on a shared_drive so that all can access that sheet through VBA userform. I will provide excel VBA userform macro to everyone in my office & they will query that sheet present in shared drive. does this seem ok?
Does excel provide facility to Query data from sheet present in shared-drive & update it when required. And I want this to be queried by multiple users at a time.
I know there are other products/technologies that provides better solution than EXCEL. But I want the solution in EXCEL ONLY.
I would appreciate it if anyone can provide his/her valuable comments on this. Let me know in case you need any details.
Thanks you.
Here are some example functions getting data from/posting data to MS Access (took me awhile to dig these up, hah!). This uses a Reference to the Microsoft DAO 3.6 Object Library and will only work with legacy .mdb files, not accdb (because the mdb driver is 100x faster and doesn't have a memory leak.)
Const DBPath As String = "Full\Database\Path"
Function GET_ACCESS_DATA(DBPath, SQL) As Object
Dim dbConn As Object
Dim dbRS As Object
Dim SQL As String
On Error GoTo ErrorHandler
SQL = "Sql Query"
'Set up database connection string
Application.StatusBar = "Connecting to Database..."
'Open database connection
Set dbConn = OpenDatabase(DBPath)
'Run the query
Application.StatusBar = "Running Query..."
Set dbRS = dbConn.OpenRecordset(SQL, DAO.dbOpenForwardOnly, DAO.RecordsetOptionEnum.dbReadOnly)
'If no rows returned, display error message and exit
If dbRS.RecordCount = 0 Then
Application.StatusBar = "Running Query...Error"
MsgBox "There are no records for the selected criteria.", vbInformation, "Refresh Data"
Application.StatusBar = "REFRESHING DATA PLEASE WAIT.."
Exit Function
End If
'returns DAO Recordset with the data
Set GET_ACCESS_DATA = dbRS
'A recordset can either be looped through or pasted to a spreadsheet with the Worksheet.Range.CopyFromRecordset method
'Error trap here
End Function
Function POST_TO_ACCESS() As Boolean
POST_TO_ACCESS = False
errormod = "TRACKING"
On Error GoTo ERROR_TRAP:
'START CONTROLS
Application.StatusBar = "Formatting Data"
St_Timer = Timer 'start connection timer
Dim cn As DAO.Database
Set cn = DAO.OpenDatabase(DBPath)
En_Timer = Timer 'get connection time
'SetKey Parameters
UserNM = Replace(User_Name(), Chr(39), "")
CompNm = Environ("COMPUTERNAME")
Elapsed_Time = En_Timer - St_Timer
SQL = "INSERT INTO TBL_TRACKING " & _
"(UserNM) " & _
" VALUES ('" & UserNM & "')"
cn.Execute SQL
cn.Close
'END CONTROLS
Application.StatusBar = False
POST_TO_ACCESS = True
'error trap here
End Function
Function User_Name()
'This just gets the LDAP username of whoever is logged in. Useful for tracking. Not guarenteed to work for your Active Directory :)
Dim WshNetwork
Dim objAdoCon, objAdoCmd, objAdoRS
Dim objUser, objRootDSE
Dim strDomainDN, strUserName, strUserFullName
strUserFullName = ""
Set WshNetwork = CreateObject("WScript.Network")
strUserName = WshNetwork.UserName
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomainDN = objRootDSE.Get("defaultNamingContext")
Set objAdoCon = CreateObject("ADODB.Connection")
objAdoCon.Open "Provider=ADsDSOObject;"
Set objAdoCmd = CreateObject("ADODB.Command")
Set objAdoCmd.ActiveConnection = objAdoCon
objAdoCmd.CommandText = _
"SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
"objectCategory='person' AND objectClass='user' AND " & _
"sAMAccountName='" & strUserName & "'"
Set objAdoRS = objAdoCmd.Execute
If (Not objAdoRS.EOF) Then
Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)
objUser.GetInfoEx Array("displayName"), 0
strUserFullName = objUser.Get("displayName")
Set objUser = Nothing
User_Name = strUserFullName
Else
End If
Set objAdoRS = Nothing
Set objAdoCmd = Nothing
objAdoCon.Close
Set objAdoCon = Nothing
Set objRootDSE = Nothing
Set WshNetwork = Nothing
End Function