INSERT INTO table with Foreign Key from Form - ms-access

I am trying to create a Form that is used to manually enter data in certain scenarios. Most data is input from CSV files which is working fine. I have 4 tables, Part , Assembly , MachineOrder , and Job. I was able to write code for entering into the base table, Part, from the Form no problem. The issue now is entering data into the Assembly and MachineOrder tables where the Parts are being referenced by their PID autonumber field and the Assemblies are being referenced by their AID autonumbered field. I have tried many different kinds of methods to perform this of which you can see a bit of in my commented out code. What is there is what I believe to be my closest to correct code thus far with the error now being that Access asks me for the parameter value of rPID even though it is finding the value in the Dlookup function fine. I'm assuming the same is true for the rAID section as well.
Otherwise I'm getting errors of Key Violations when using the INSERT then UPDATE method you see commented out.
The form is called HOTEntry
Any advice on what my problem may be is greatly appreciated, I'm a student and this is my first time trying to use what I've learned in a professional application so any and all constructive criticism is wanted! Apologies if this is a rather specific question but I could really use the help on this since I've been working on it for two days to no avail...
My code:
Sub HOTParts2()
Dim rPID As Integer
Dim rAID As Integer
Dim dbs As DAO.Database
Dim sqlstr1 As String
Dim sqlstr2 As String
Dim sqlstr3 As String
Dim sqlstr4 As String
Set dbs = CurrentDb
'sqlstr1 = "INSERT INTO Assembly ( PID, ModelNum, ModelRev, ModelDescription ) " _
' & "SELECT (PID,Forms!HOTEntry!txtHotModel, Forms!HOTEntry!txtHotRev, Forms!HOTEntry!txtHotDes)" _
' & "FROM Part " _
' & "WHERE Part.PartName = Forms!HOTEntry!txtPartName AND Part.Config = Forms!HOTEntry!txtConfigEntry AND Part.Rev = Forms!HOTEntry!txtRevEntry"
sqlstr1 = "INSERT INTO Assembly ( ModelNum, ModelRev, ModelDescription,PID ) " _
& "VALUES (Forms!HOTEntry!txtHotModel, Forms!HOTEntry!txtHotRev, Forms!HOTEntry!txtHotDes," & "rPID" & ");"
'
'sqlstr2 = "UPDATE Assembly " _
' & "SET PID =" & rPID & " " _
' & "WHERE Assembly.ModelNum = Forms!HOTEntry!txtHotModel And Assembly.ModelDescription = Forms!HOTEntry!txtHotDes And Assembly.ModelRev = Forms!HOTEntry!txtHotRev;"
'
'sqlstr3 = "INSERT INTO MachineOrder ( AID, Serial, CustName ) " _
' & "SELECT (AID,Forms!HOTEntry!txtHotSerial, Forms!HOTEntry!txtHotCust)" _
' & "FROM Assembly" _
' & "WHERE Assembly.Model=Forms!HOTEntry!txtHotModel And ModelDescription= Forms!HOTEntry!txtHotDes And ModelRev = Forms!HOTEntry!txtHotRev; "
sqlstr3 = "INSERT INTO MachineOrder (Serial, CustName, AID ) " _
& "VALUES (Forms!HOTEntry!txtHotSerial, Forms!HOTEntry!txtHotCust," & "rAID" & ");"
'
'sqlstr4 = "UPDATE MachineOrder " _
' & "SET AID =" & rAID & " " _
' & "WHERE AID IS NULL;"
rPID = DLookup("PID", "Part", "PartName = " & "'" & Forms!HOTEntry!txtPartName & "'" & " And " & "Config = " & "'" & Forms!HOTEntry!txtConfigEntry & "'" & " And " & "Rev = " & "'" & Forms!HOTEntry!txtRevEntry & "'")
DoCmd.RunSQL sqlstr1
'DoCmd.RunSQL sqlstr2
rAID = DLookup("AID", "Assembly", "ModelNum = " & "'" & Forms!HOTEntry!txtHotModel & "'" & " And " & "ModelDescription = " & "'" & Forms!HOTEntry!txtHotDes & "'" & " And " & "ModelRev = " & "'" & Forms!HOTEntry!txtHotRev & "'")
DoCmd.RunSQL sqlstr3
'DoCmd.RunSQL sqlstr4
End Sub

Well, if you want to use the looked up rPID and rAID in a query, you need to do more than just set them in VBA. You can either manually fill them in in your SQL statement, use a parameter and a QueryDef and fill in the parameter in your QueryDef, or put the DLookUp inside your SQL statement.
Going with the first approach here, only unquoted rPID in your initial statement, and put it after rPID was set.:
rPID = DLookup("PID", "Part", "PartName = " & "'" & Forms!HOTEntry!txtPartName & "'" & " And " & "Config = " & "'" & Forms!HOTEntry!txtConfigEntry & "'" & " And " & "Rev = " & "'" & Forms!HOTEntry!txtRevEntry & "'")
sqlstr1 = "INSERT INTO Assembly ( ModelNum, ModelRev, ModelDescription,PID ) " _
& "VALUES (Forms!HOTEntry!txtHotModel, Forms!HOTEntry!txtHotRev, Forms!HOTEntry!txtHotDes," & rPID & ");"
DoCmd.RunSQL sqlstr1

Related

Acces VBA DLOOKUP

Teller = Nz(DLookup("[Teller]", "[Lookuptable]", ("Artikel = '" & ValueArtikel & "' " And " Lookuptable= 'G'")), 0)
Noemer = Nz(DLookup("[Noemer]", "[lookuptable]", ("Artikel = ' " & ValueArtikel & " ' " And Lookuptable= " 'G' ")), 0)
I want to perform a DLOOKUP in acces vba but i can't find the right statement. I looked at many sites and this are the two dlookups that i think are correct but both give the error types don't match. Teller and noemer are integers, Artikel and artikelvalue and Lookuptable are strings. Sorry if this is already asked but i can't find it. i find many posts about it but i can't fixed it. And especcialy sorry for my bad english
The first one is close. Use variables and Debug.Print to help building the strings.
Ctrl+g shows the output.
strCrit = "Artikel = '" & ValueArtikel & "' And Lookuptable= 'G'"
Debug.Print strCrit
Teller = Nz(DLookup("[Teller]", "[Lookuptable]", strCrit), 0)
I use my own function for Lookups because Lookups have a really bad performance.
' Lookups Replacements
'---------------------
Function DLook(Expression As String, Domain As String, Optional Criteria) As Variant
On Error GoTo Err_Handler
Dim strSQL As String
'DCount: strSQL = "SELECT COUNT(" & Expression & ") FROM " & Domain
'Other replacements
'DLookup:
strSQL = "SELECT " & Expression & " FROM " & Domain
'DMax: strSQL = "SELECT MAX(" & Expression & ") FROM " & Domain
'DMin: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DFirst: strSQL = "SELECT FIRST(" & Expression & ") FROM " & Domain
'DLast: strSQL = "SELECT LAST(" & Expression & ") FROM " & Domain
'DSum: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DAvg: strSQL = "SELECT AVG(" & Expression & ") FROM " & Domain
If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria
DLook = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
Exit Function
Err_Handler:
MsgBox "Error. Lookup couldnt be performed" & vbNewLine & Err.Description, vbCritical
End Function
Called with:
If DLook("Column2", "Table1", "Column1 = " & ID) = 0 Then
'Do stuff
End If
If DLook("Column2", "Table1") = 0 Then
'Do other stuff
End If

CheckIfExist. If exist don't insert the data, if not insert the data

I have a problem on how to insert data into two different table. So my requirements is this.
Under Group Details, The user need to click all the needed information on the dropdown menu and input on the textbox of the table grid view before clicking the ADD Link, after this the page will load displaying the Added Job Title and business group details. The user is allowed to input as many Job title as the user want.
I already finished the table but I have problems in saving the data that I input.
So my first table looks like this Before
and I edit it and this is my table Now
So my problem is this, in my database i have two table. One is EMPGROUP_TBL with columns SEQID, masterID, Business Unit, Division, Sub-Division etc. and the other is EMP_MASTERTBL with columns MasterID, Name, LastName, Jobtitle.
Now everytime I click Add link the jobtitle will not be able to save in the EMP_MASTERTBL so I create a code in VB.Net that will update the EMP_MASTERTBL table when I click the add button under Group Details.
Here's my codes.
If UpdateInsDelRecord("INSERT INTO EMPGROUP_TBL (MASTERID, BUSINESS_UNIT, " & _
"DIVISION, SUB_DIVISION, CLASSIFICATION, SUB_CLASSIFICATION) VALUES " & _
"('" & HandleQuote(Me.lblval_Empid.Text) & "', " & _
"'" & Me.ddl_BusinessUnit.SelectedValue.ToString() & "' ," & _
"'" & val_division & "' ," & _
"'" & val_subdivision & "' ," & _
"'" & Me.ddl_Classification.SelectedValue.ToString() & "' ," & _
"'" & Me.ddl_SubClassification.SelectedValue.ToString() & "')" & _
";" & _
"UPDATE EMP_MASTERTBL SET JOBTITLE = '" & Me.txtJobtitle.Text & "' " & _
"WHERE MASTERID = '" & Me.lblval_Empid.Text & "'") = True Then
Return True
Response.Redirect("eHR_EmpMaintenance.aspx")
Else
Return False
End If
But the user must be able to add as many as Jobtitle and EMPGROUP_TBL details as the user want. So I'm thinking that I'll just write another query for that? How can I add the Group Details and be able to add as many as Jobtitle as the user want?
CheckIfExist
I figured maybe I could use the CheckIfExist and if the employee has an existing data to the jobtitle, business unit, division, sub-division, classification and sub-classification similar to the one that you will add, the messagebox will show that the data already exist. If no data found then it will be able to add the details under the employee's group details. And if you input similar jobtitle but different business unit etc. the data will just be updated and vice versa.
Here's what my code for this.
Function SaveUserGroup() As Boolean
Try
Dim jobtitle As String = Me.txtJobtitle.Text
Dim businessunit As String = Me.ddl_BusinessUnit.SelectedValue
Dim division As String = Me.ddl_Division.SelectedValue
Dim subdivision As String = Me.ddl_SubDivision.SelectedValue
Dim classification As String = Me.ddl_Classification.SelectedValue
Dim subclassification As String = Me.ddl_SubClassification.SelectedValue
Dim CheckMasterTblIfExist As Boolean
Dim CheckGroupTblIfExist As Boolean
Dim insrtResult As Boolean
Dim seqid As String = Me.lblSEQID.Text
Dim emp_id As String = Request.QueryString("emp_id")
If jobtitle <> "" And businessunit <> "Please Select" And division <> "Please Select" And subdivision <> "Please Select" And classification <> "Please Select" And subclassification <> "Please Select" Then
CheckMasterTblIfExist = CheckRecord("SELECT MASTERID, JOBTITLE FROM EMP_MASTERTBL WHERE JOBTITLE = '" & jobtitle & "' AND MASTERID = '" & emp_id & "' ")
CheckGroupTblIfExist = CheckRecord("SELECT * FROM EMPGROUP_TBL WHERE BUSINESS_UNIT = '" & businessunit & "' AND DIVISION = '" & division & "' AND SUB_DIVISION = '" & subdivision & "' AND CLASSIFICATION = '" & classification & "' AND SUB_CLASSIFICATION = '" & subclassification & "' AND MASTERID = '" & emp_id & "' AND SEQID = '" & seqid & "'")
If Not CheckMasterTblIfExist And CheckGroupTblIfExist Then
insrtResult = UpdateInsDelRecord("UPDATE EMP_MASTERTBL SET JOBTITLE = '" & jobtitle & "' " & _
"WHERE MASTERID = '" + Me.lblval_Empid.Text + "'" & _
";" & _
"INSERT INTO EMPGROUP_TBL(MASTERID, BUSINESS_UNIT, " & _
"DIVISION, SUB_DIVISION, CLASSIFICATION, SUB_CLASSIFICATION) VALUES " & _
"('" & HandleQuote(Me.lblval_Empid.Text) & "', " & _
"'" & businessunit & "' ," & _
"'" & division & "' ," & _
"'" & subdivision & "' ," & _
"'" & classification & "' ," & _
"'" & subclassification & "')")
If Not insrtResult Then
MessageBox("alert('Error Ocurred While Inserting a Data.')")
Else
MessageBox("alert('Successfully Added.')")
End If
Else
MessageBox("alert('Data Already Exist.')")
End If
End If
Catch ex As Exception
MessageBox("Error Ocurred while Inserting a data")
Throw
End Try
End Function
I haven't been completed the code yet. I'm in the adding if there's no data and my problem is that the messagebox keeps on telling me that the data already exist even if there's still no employee's group details that added. Please help me with this.
begin tran
if exists (select * from table with (updlock,serializable) where key = #key)
begin
update table set ...
where key = #key
end
else
begin
insert into table (key, ...)
values (#key, ...)
end
commit tran
you can use like this

Check if Exist or Not then Insert Update

I need to check if the data exist if the data didn't exist then I'll be able to insert and update but if the data exist the messagebox will show that the data already exist but when I tried to add same data that already exist it still add and no messagebox shown that it already exist.
here's my code
If jobtitle <> "" And businessunit <> "Please Select" And division <> "Please Select" And subdivision <> "Please Select" And classification <> "Please Select" And subclassification <> "Please Select" Then
insrtResult = UpdateInsDelRecord("UPDATE EMP_MASTERTBL SET JOBTITLE = '" & jobtitle & "' " & _
"WHERE MASTERID = '" & empID & "'" & _
";" & _
"INSERT INTO EMPGROUP_TBL(MASTERID, BUSINESS_UNIT, " & _
"DIVISION, SUB_DIVISION, CLASSIFICATION, SUB_CLASSIFICATION) VALUES " & _
"('" & HandleQuote(empID) & "', " & _
"'" & businessunit & "' ," & _
"'" & division & "' ," & _
"'" & subdivision & "' ," & _
"'" & classification & "' ," & _
"'" & subclassification & "')")
If Not insrtResult Then
MessageBox("alert('Error Ocurred While Inserting a Data.')")
Else
MessageBox("alert('Successfully Added.')")
End If
Else
MessageBox("alert('Data Already Exist.')")
End If
what could be the problem to my code? Thanks in advance.
For SQL Server check the MERGE query, i used this to perform an "upsert" on my own db, it also seems to be performing fast enough.
You can chose a condition and perform different operations whether it returns true or false (e.g. if ID already exists then update, else insert)
For MySql i think there are solutions much more easier to write, wich unfortunatly i can't remember at the moment
https://msdn.microsoft.com/en-us/library/bb510625.aspx

error 2501 access vba

When I run this code, I get "The Open Form action was canceled" with an error code of 2501 The line it gets caught on when I debug is the DoCmd.RunSQL (Req)
Function Compare()
Dim oDB As DAO.Database
Dim oRst As DAO.Recordset
Dim nbligne As Long
Dim Req As String
Dim default As String
Dim tables As String
Dim table
Dim i As Integer
Dim champ As String
Dim j As Integer
Set oDB = CurrentDb
Set oRst = oDB.OpenRecordset("SELECT Count(*) FROM CELLCAC;")
nbligne = oRst.Fields(0).Value
Set oRs = CurrentDb.OpenRecordset("CELLCAC")
Set fs = CreateObject("Scripting.FileSystemObject")
Set fldr = fs.getfolder("C:\Users\Documents\Application\Application_vba\Delta")
Set fls = fldr.files
Set fld = CurrentDb.OpenRecordset("TABLES_A_VERIFIER_DEFAULT")
For Each fl In fls
If fl Like "*.txt" Then
source = Left(fl.Name, Len(fl.Name) - 4)
tables = source
default = "DEFAULT_" & tables
table = CurrentDb.OpenRecordset(default)
For i = 0 To table.Count - 1
champ = table(i).Name
Req = "INSERT INTO DELTA_DEFAULT(BSCNAME, CELLNAME, MO, PARAMETRE ,DEFAULT ,RESEAU)" _
& "select DISTINCT [" & tables & "]![BSCNAME], [" & tables & "]![CELLNAME],('" & tables & "'), ('" & champ & "') ,[" & default & "]![" & champ & "],[" & tables & "]![" & champ & "] " _
& " from (" & tables & ") INNER join (" & default & ") on ( " & default & ".Zone = " & tables & ".Zone ) " _
& " Where [" & default & "]![" & champ & "] <> [" & tables & "]![" & champ & "];"
DoCmd.RunSQL (Req)
Next i
End If
Next fl
End Function
Instead of doing : DoCmd.RunSQL (Req),
can you try : oDB.Execute (Req)
I had several issues and this helps me a lot !
From the first line of your req query to the second line, you need to add a space character.
I believe that currently the query will not recognise the word SELECT if it is joined to the closed bracket.
Req = "INSERT INTO DELTA_DEFAULT(BSCNAME, CELLNAME, MO, PARAMETRE,DEFAULT ,RESEAU)" _
& " select
In addition; from what I understood I would have used the VALUES clause when creating an INSERT INTO statement. Perhaps:
Req = "INSERT INTO DELTA_DEFAULT(BSCNAME, CELLNAME, MO, PARAMETRE ,DEFAULT ,RESEAU)" _
& " VALUES (select DISTINCT [" & tables & "]![BSCNAME], [" & tables & "]![CELLNAME],('" & tables & "'), ('" & champ & "') ,[" & default & "]![" & champ & "],[" & tables & "]![" & champ & "] " _
& " from (" & tables & ") INNER join (" & default & ") on ( " & default & ".Zone = " & tables & ".Zone ) " _
& " Where [" & default & "]![" & champ & "] <> [" & tables & "]![" & champ & "]);"

Dates are not updating through sql code in vba

I want to update serial.Issuedate getting from form but its giving syntax error.
Please help me how can I correct this error.
My code is below:
Private Sub Command30_Click()
Set serialrs = CurrentDb.OpenRecordset("serial")
Dim Idate As Date
Dim Itodo As String
Idate = Me.IssuedDate.Value
Itodo = Me.IssuedToDO.Value
Dim issueqry As String
issueqry = "UPDATE serial " _
& " set serial.IssueToDO = '" & Itodo & "'" _
& " serial.issuedate = (#" & Format(Idate, "mm\/dd\/yyyy") & "#)" _
& " WHERE (((serial.id) Between 1 And 10)) "
DoCmd.RunSQL issueqry
MsgBox ("Issued Done")
End Sub
When you update more than one field, you must include a comma between the field expressions like this ...
SET [field name] = "foo", [another field] = 17
^
here
So try your code like this ...
issueqry = "UPDATE serial " _
& " set serial.IssueToDO = '" & Itodo & "'," _
& " serial.issuedate = #" & Format(Idate, "mm/dd/yyyy") & "#" _
& " WHERE serial.id Between 1 And 10"
Also give yourself an opportunity to inspect the string the code built ...
Debug.Print issueqry
You can view the output from Debug.Print in the Immediate window. Ctrl+g will take you there.