Access VBA/Prevent duplicate values - ms-access

How I can prevent duplicate values to not insert into the table. I have created a code to INSERT, UPDATE and DELETE and I want to display a MsgBox that there is a duplicate value and to cancel it. Thanks. Below you have the code:
Private Sub Command12_Click()
If Me.emID.Tag & "" = "" Then
If (IsNull(Me.emID) Or (Me.emID = "") Or IsNull(Me.emFirst) Or (Me.emFirst = "") Or IsNull(Me.emLast) Or (Me.emLast = "")) Then
Me.emID.BorderColor = vbRed
Me.emFirst.BorderColor = vbRed
Me.emLast.BorderColor = vbRed
MsgBox "Please fill required fields", vbInformation, "Information"
Exit Sub
End If
CurrentDb.Execute "INSERT INTO tblEmployees(emID, first, last, gender, phone, mobphone, city, state, zip, adress, email, comment)" & _
"VALUES ('" & Me.emID & "', '" & Me.emFirst & "', '" & Me.emLast & "', '" & Me.emGender & "', '" & Me.emPhone & "', '" & Me.emMob & "', '" & Me.emCity & "', '" & Me.emState & "', '" & Me.emZip & "', '" & Me.emAdress & "', '" & Me.emEmail & "', '" & Me.emComment & "')"
MsgBox "Record Added", vbInformation, "information"
Else
CurrentDb.Execute "UPDATE tblEmployees " & _
"SET emiD =" & Me.emID & _
", first ='" & Me.emFirst & "'" & _
", last = '" & Me.emLast & "'" & _
", gender ='" & Me.emGender & "'" & _
", phone = '" & Me.emPhone & "'" & _
", mobphone ='" & Me.emMob & "'" & _
", city ='" & Me.emCity & "'" & _
", state ='" & Me.emState & "'" & _
", zip ='" & Me.emZip & "'" & _
", adress ='" & Me.emAdress & "'" & _
", email ='" & Me.emEmail & "'" & _
", comment ='" & Me.emComment & "'" & _
"WHERE emID =" & Me.emID.Tag
MsgBox "Updated!", vbInformation, "Information"
End If
Me.tblEmployees_subform.Form.Requery
End Sub

It sounds like you'd like to update an employee if one exists for the given ID otherwise you'd like to add a new employee. You can prevent adding duplicate employees by first trying to update an employee record with the given ID and if no records were updated only then do you add a new employee record.
Private Sub Command12_Click()
If (IsNull(Me.emID) Or (Me.emID = "") Or IsNull(Me.emFirst) Or (Me.emFirst = "") Or IsNull(Me.emLast) Or (Me.emLast = "")) Then
Me.emID.BorderColor = vbRed
Me.emFirst.BorderColor = vbRed
Me.emLast.BorderColor = vbRed
MsgBox "Please fill required fields", vbInformation, "Information"
Exit Sub
End If
' You must set CurrentDb to a variable otherwise the RecordsAffected
' property used later will be incorrect.
Dim db As DAO.Database
Set db = CurrentDb
' First try to update an existing employee.
db.Execute _
"UPDATE tblEmployees " & _
"SET first ='" & Me.emFirst & "', " & _
"last = '" & Me.emLast & "', " & _
"gender ='" & Me.emGender & "', " & _
"phone = '" & Me.emPhone & "', " & _
"mobphone ='" & Me.emMob & "', " & _
"city ='" & Me.emCity & "', " & _
"state ='" & Me.emState & "', " & _
"zip ='" & Me.emZip & "', " & _
"adress ='" & Me.emAdress & "', " & _
"email ='" & Me.emEmail & "', " & _
"comment ='" & Me.emComment & "'" & _
"WHERE emID =" & Me.emID.Tag & ";"
' If no records were affected by update then add a new employee.
If db.RecordsAffected = 0 Then
db.Execute _
"INSERT INTO tblEmployees(emID, first, last, gender, phone, mobphone, city, state, zip, adress, email, comment) " & _
"VALUES ('" & Me.emID & "', '" & Me.emFirst & "', '" & Me.emLast & "', '" & Me.emGender & "', '" & Me.emPhone & "', '" & Me.emMob & "', '" & Me.emCity & "', '" & Me.emState & "', '" & Me.emZip & "', '" & Me.emAdress & "', '" & Me.emEmail & "', '" & Me.emComment & "');"
MsgBox "Record Added", vbInformation, "Information"
Else
MsgBox "Updated!", vbInformation, "Information"
End If
Me.tblEmployees_subform.Form.Requery
End Sub
Note: In the update query I removed the update to the emID field since that is what the query is based on (in the WHERE clause). If the emID field is changing you won't be able to use the new emID value to find an employee record with the old emID value.
If you never want any duplicates I would also suggest that you add constraints to your database table to prevent duplicates, as suggested by Daniel Cook. I would also suggest looking into using parameterized queries instead of building SQL strings in VBA.

You can change your SQL to use IF EXISTS condition and insert only if the records does not already exists.
Your SQL may look like:
IF NOT EXISTS
(
SELECT ......
)
BEGIN
INSERT INTO tblEmployees ......<insert since employee does not exists>
END

Related

MS Access combobox syntax error

still new to this, I wanted to add a combobox to my sql statement and keep getting an error. Can someone explain how to fix and how to add more combobox statements. I have about 20 columns, just testing one at a time.
Private Sub btn_Add_Click()
CurrentDb.Execute _
"INSERT INTO IPA_Raw_Data([Date], Auditor, Line_Clearance) " & _
"VALUES (#" & Format(Me!txt_Date.Value, "yyyy\/mm\/dd") & "#,'" & _
Me!txt_Name.Value & "','" & Me!cb_LC.Value & "')"
btn_Clear_Click
I was able to get it to work! I'm sorry for the delayed response and thank you guys for input. It was just syntax of the way I entered it.
Private Sub btn_Add_Click()
CurrentDb.Execute _
"INSERT INTO IPA_Raw_Data(Date_IPA, Auditor, Area, Operator, Safely, LineClearance, PPE, VerifyDoc, GVI, CompBefore, NonConf, ProcSteps, Trained, Points, Comments) " & _
"VALUES ('" & Me.txt_Date.Value & "', '" & Me!txt_Name.Value & "', '" & Me!txt_Area.Value & "', '" & Me!txt_Operator.Value & "', '" & Me!cb_Safe.Value & "', '" & Me!cb_LC.Value & "', '" & Me!cb_PPE.Value & "', '" & Me!cb_VDP.Value & "', '" & Me!cb_GVI.Value & "', '" & Me!cb_CBF.Value & "', '" & Me!cb_NC.Value & "', '" & Me!cb_ProStep.Value & "', '" & Me!cb_TrainProc.Value & "', '" & Me!txt_Points.Value & "', '" & Me!txt_Comment.Value & "')"
btn_Clear_Click
End Sub

Open Report Use Three Combobox Filter

I have 3 combobox to filter data, then i want to open in command button to print preview..
Problems I have if i used 2 combobox it works but when i used three combobox the report is blank...there's any problems with the code?? here's the code i used :
Dim strWhereCondition As String
strWhereCondition = "[month] = '" & Me.cbmonth.Value _
& "' and [Works] = '" & Me.cbwork.Value _
& "' and [Works] = '" & Me.cbwork2.Value & "'"
Debug.Print strWhereCondition
DoCmd.OpenReport "Month List", View:=acViewPreview, _
WhereCondition:=strWhereCondition
and the requery for my form
SELECT *
FROM MyTable
WHERE (month = Forms!nameForm!cbmonth
OR Forms!MeForm!cbwork IS NULL)
And (works = Forms!nameForm!cbwork
OR Forms!nameForm!cbwork IS NULL)
AND (works = Forms!nameForm!cbwork2
OR Forms!nameForm!cbwork2 IS NULL);
can anyone help?
Month is a number, so try:
strWhereCondition = "[month] = " & Me.cbmonth.Value _
& " and [Works] = '" & Me.cbwork.Value _
& "' and [Works] = '" & Me.cbwork2.Value & "'"
Edit: Month is text.
However, [Work] is supposed to match two potentially different values:
& "' and [Works] = '" & Me.cbwork.Value _
& "' and [Works] = '" & Me.cbwork2.Value & "'"
Should most likely be:
& "' and [Works] = '" & Me.cbwork.Value _
& "' and [SomeOtherField] = '" & Me.cbwork2.Value & "'"

How I can update attachments and file path?

I have created a table where I'm saving attachments(in external folder) and file paths in the table. When I'm trying to update existing attachment with another, it does not work. Please see below "Add file" code and "Update button" code.
Private Sub cmAdd_Click()
On Error Resume Next
Dim strLokacioni As String
Dim strSQL As String
strLokacioni = "C:\Users\HSE\Desktop\datas\" & getFileName(Me.path.Value)
strSQL = "INSERT INTO tbl_tracker(path, filename, IncNo, PATS, SAP, First, Last, IncDate, Description, Location, OshaType, IncType, RootCause,Inspector, Surfaces, WeatherCon, WorkRelated, IncTime)" & _
"VALUES ( '" & strLokacioni & "', '" & Me.path.Value & "', '" & Me.txtInc & "', '" & Me.txtPATS & "', '" & Me.txtSAP & "', '" & Me.txtFirst & "', '" & Me.txtLast & "', '" & Me.txtDate & "', '" & Me.txtDesc & "', '" & Me.cmbLoc & "', '" & Me.cmbOsha & "', '" & Me.cmbType & "', '" & Me.txtCause & "', '" & Me.cmbInsp & "', '" & Me.cmbSur & "', '" & Me.cmbWcon & "', '" & Me.cmbRelated & "', '" & Me.txtTime & "')"
CurrentDb.Execute (strSQL)
MsgBox "Record Added", vbInformation, "Information"
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
fso.CopyFile Me.path.Value, strLokacioni
Set fso = Nothing
Me.tbl_tracker_subform.Form.Requery
End Sub
' Below is update button code
Private Sub Command88_Click()
'On Error Resume Next
Dim strLokacioni As String: strLokacioni = "C:\Users\HSE\Desktop\datas\" & getFileName(Me.path.Value)
Me.path = strLokacioni
CurrentDb.Execute "UPDATE tbl_tracker " & _
" SET IncNo = " & Me.txtInc & _
", path = '" & strLokacioni & "'" & _
", filename = '" & Me.filename & "'" & _
", PATS = '" & Me.txtPATS & "'" & _
", SAP = '" & Me.txtSAP & "'" & _
", First = '" & Me.txtFirst & "'" & _
", Last = '" & Me.txtLast & "'" & _
", IncDate = '" & Me.txtDate & "'" & _
", Location = '" & Me.cmbLoc & "'" & _
", Description = '" & Me.txtDesc & "'" & _
", OshaType = '" & Me.cmbOsha & "'" & _
", Inctype = '" & Me.cmbType & "'" & _
", RootCause = '" & Me.txtCause & "'" & _
", Inspector = '" & Me.cmbInsp & "'" & _
", Surfaces = '" & Me.cmbSur & "'" & _
", WeatherCon = '" & Me.cmbWcon & "'" & _
", WorkRelated = '" & Me.cmbRelated & "'" & _
", IncTime = '" & Me.txtTime & "'" & _
" WHERE IncNo = " & Me.txtInc.Tag
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
fso.CopyFile Me.path.Value, strLokacioni
Set fso = Nothing
MsgBox "Record Updated", vbInformation, "Information"
Me.tbl_tracker_subform.Form.Requery
End sub
And the the value Me.path.Value at the start of Command88_click is coming from :
Public Function getFileName(ByVal strPath As String) As String
If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
getFileName = getFileName(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
End If
End Function
Private Sub cbdBrowse_Click()
On Error Resume Next
Dim f As Object
Set f = Application.FileDialog(msoFileDialogFilePicker)
f.AllowMultiSelect = False
f.Show
Me.path.Value = f.SelectedItems(1)
End Sub
When I use update queries like you have here, I would always use the following syntax.
dim db as database
set db = currentDb
db.execute "UPDATE...."
would you require the same? Or have I been going about this a long way.
Also, I would have left a comment as this may not be the answer. Unfortunately, I cant due to rep<50

Run-time error '3061': Too Few Parameters. Expected 2

So I'm trying to teach myself VBA again and I'm having a cople of troubles. I'm trying to add new users to a table but keep getting the above error when I click my "Update" button. The text field will be in the form of 2 letters and 5 numbers. XX11111 for example.
Private Sub cmdAdd_Click()
'when we click on button Add there are two options
'1. for insert
'2. for update
If Me.txtLoginName.Tag & "" = "" Then
'add data to table
CurrentDb.Execute "INSERT INTO tblUsers(LoginName,UserName,Rank) " & _
" VALUES('" & Me.txtLoginName & "','" & Me.txtUsername & "','" & Me.cboRank & "')"
Else
CurrentDb.Execute "UPDATE tblUsers " & _
"set LoginName=" & Me.txtLoginName & "'" & _
", UserName='" & Me.txtUsername & "'" & _
", Rank='" & Me.cboRank & "'" & _
" WHERE LoginName=" & Me.txtLoginName.Tag
End If
'clear form
cmdClear_Click
'refresh data in list on form
frmModifyUsersSub.Form.Requery
End Sub
you are missing a ' in this line:
" set LoginName=" & Me.txtLoginName & "'" & _
change it to
" set LoginName='" & Me.txtLoginName & "'" & _
and :
" WHERE LoginName=" & Me.txtLoginName.Tag
to
" WHERE (LoginName='" & Me.txtLoginName.Tag & "')" ' and I don't know if this your intended where condition.
The error pretty much gives you the answer. You need 2 parameters for the function it is failing on. One thing to try is to change
CurrentDb.Execute "INSERT INTO tblUsers(LoginName,UserName,Rank) " & _
" VALUES('" & Me.txtLoginName & "','" & Me.txtUsername & "','" & Me.cboRank & "')"
and
CurrentDb.Execute "UPDATE tblUsers " & _
"set LoginName=" & Me.txtLoginName & "'" & _
", UserName='" & Me.txtUsername & "'" & _
", Rank='" & Me.cboRank & "'" & _
" WHERE LoginName=" & Me.txtLoginName.Tag
To
CurrentDb.Execute "INSERT INTO tblUsers(LoginName,UserName,Rank) " & _
" VALUES('" & Me.txtLoginName & "','" & Me.txtUsername & "','" & Me.cboRank & "')",dbFailOnError
and
CurrentDb.Execute "UPDATE tblUsers " & _
"set LoginName='" & Me.txtLoginName & "'" & _
", UserName='" & Me.txtUsername & "'" & _
", Rank='" & Me.cboRank & "'" & _
" WHERE LoginName='" & Me.txtLoginName.Tag & "'", dbFailOnError

How to insert correct value from DropDownList into Database Table

I have a form where an admin can add a company to a database table called 'Company'
In this form there is a Drop Down list to select whether a company is a Scholarship Company, there are two options 'Yes' and 'No'. I have created a table to pull these options from called 'YesNo'.
When I select Yes in the drop down list and hit submit it updates the table so the cell for ScholarshipCompany is '1' and not 'Yes'. This works fine in the edit form I have which just updates the company though I am having trouble with the add company form which inserts a new entry into the table.
Please see code below;
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If Session("Name") = Nothing Then
Response.Redirect("Login.aspx")
End If
Session("Name") = Session("Name")
Session("Username") = Session("Username")
Try
If Not IsPostBack Then
Dim locationList As OleDbDataReader = Database.DoSQLReturnDataReader("SELECT [{Location}].ID, [{Location}].Location FROM [{Location}] ORDER BY [{Location}].ID")
ddlLocation.DataSource = locationList
ddlLocation.DataTextField = "Location"
ddlLocation.DataValueField = "ID"
ddlLocation.DataBind()
locationList.close()
Dim statusList As OleDbDataReader = Database.DoSQLReturnDataReader("SELECT * FROM EmployerStatus ORDER BY ID ASC")
ddlStatus.DataSource = statusList
ddlStatus.DataTextField = "Status"
ddlStatus.DataValueField = "ID"
ddlStatus.DataBind()
statusList.close()
Dim yesnoList As OleDbDataReader = Database.DoSQLReturnDataReader("SELECT * FROM YesNo ORDER BY ID DESC")
ddlYesno.DataSource = yesnoList
ddlYesno.DataTextField = "Option"
ddlYesno.DataValueField = "Option"
ddlYesno.DataBind()
yesnoList.close()
End If
Catch ex As Exception
Response.Redirect("index.aspx?Yr=" & Replace(Request.QueryString("Yr"), "'", "''"))
End Try
End Sub
Protected Sub BtnSubmit_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles BtnSubmit.Click
Dim strSql As String = "INSERT INTO Company(" & _
"CompanyName, " & _
"URL, " & _
"Location, " & _
"EmployerStatus, " & _
"Address, " & _
"ScholarshipCompany, " & _
"ScholarshipNotes, " & _
"Town, " & _
"County, " & _
"Blurb, " & _
"InterviewTips, " & _
"HRContactForename, " & _
"HRContactSurname, " & _
"HREmail, " & _
"Telephone, " & _
"[Password], " & _
"Fax, " & _
"HRContactForename2, " & _
"HRContactSurname2, " & _
"HREmail2, " & _
"Telephone2, " & _
"HRContactForename3, " & _
"HRContactSurname3, " & _
"HREmail3, " & _
"Telephone3, " & _
"Postcode) " & _
"VALUES " & _
"( " & _
"'" & TxtBoxCompanyName.Text.Replace("'", "''") & "', " & _
"'" & TxtBoxURL.Text.Replace("'", "''") & "', " & _
"'" & Replace((ddlLocation.SelectedIndex + 1), "'", "''") & "', " & _
"'" & Replace((ddlStatus.SelectedIndex + 1), "'", "''") & "', " & _
"'" & TxtAreaAddress.InnerText.Replace("'", "''") & "', " & _
"'" & Replace((ddlYesno.SelectedIndex), "'", "''") & "', " & _
"'" & TxtBoxSchol.Text.Replace("'", "''") & "', " & _
"'" & TxtBoxTown.Text.Replace("'", "''") & "', " & _
"'" & TxtBoxCounty.Text.Replace("'", "''") & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & "" & "', " & _
"'" & TxtBoxPostcode.Text.Replace("'", "''") & "'" & _
")"
Dim updateCompanyDetails As OleDbDataReader = Database.DoSQLReturnDataReader(strSql)
updateCompanyDetails.Close()
System.Threading.Thread.Sleep("1000")
Instead of
Replace((ddlLocation.SelectedIndex + 1), "'", "''") & "', " & _
"'" & Replace((ddlStatus.SelectedIndex + 1), "'", "''") & "', " & _
try
Replace((ddlLocation.SelectedValue + 1), "'", "''") & "', " & _
"'" & Replace((ddlStatus.SelectedValue + 1), "'", "''") & "', " & _
or SelectedText