Private Sub btnAddInfo_Click()
On Error GoTo Error_Routine
'Declare variables
Dim intStudentID As Integer
Dim intTestID As Integer
Dim dblMark As Double
Dim intResultID As Integer
'Declare database
Dim db As DAO.Database
Dim rst As DAO.Recordset
'Set the database
Set db = CurrentDb
Set rst = db.OpenRecordset("Select ResultId FROM StudentResult ORDER BY RESULTID DESC", dbOpenDynaset)
'assign value to intResultID variable
intResultID = rst!ResultId
'Adds the additional 1 to the latest result id that was used
If Not rst.EOF Then
intResultID = intResultID + 1
End If
'Assigns value to variables
intStudentID = Forms!frmAdd!lstStudentID
strDescription = Forms!frmAdd!lstTest
dblMark = txtMark.Value
intTestID = Forms!frmAdd!lstTest
'Checks that Student ID has been selected
If Not IsNull(lstStudentID) Then
'Inserts new test record into StudentResult table
db.Execute "INSERT INTO StudentResult " _
& "(ResultId,StudentId,TestId, Mark) VALUES " _
& "('" & intResultID & "','" & intStudentID & "','" & intTestID & "','" & dblMark & "');"
End If
'Clears fields
txtMark.Value = ""
lstStudentID.Value = ""
lblExistingStudent.Caption = "Existing Student Name:"
'Closes database
Set db = Nothing
I'm trying to add new records. There is a list of 4 tests. ResultId is the primary key and it is an AutoNumber column.
The button adds tests scores just fine if the selected StudentID has not added a score for that TestId yet. But when I try to add a StudentId and TestId combination that has been entered before, it does not add a new record or even update the existing one.
Both StudentId and TestId allow duplicates. I've tried doing this counter variable but it has not worked. This is for a class and the professor says a student should be able to retake tests and it should just add a new record.
Thank you in advance for your help. Please let me know if you need any pictures of the form, tables, or more of my code.
Exclude the AutoNumber field, and don't wrap numbers in quotes:
If Not IsNull(lstStudentID) Then
' Verify values:
Debug.Print "StudentID:", intStudentID, "TestID:", intTestID, "Mark:", Str(dblMark)
'Inserts new test record into StudentResult table
db.Execute "INSERT INTO StudentResult " _
& "(StudentId, TestId, Mark) VALUES " _
& "(" & intStudentID & "," & intTestID & "," & Str(dblMark) & ");"
End If
Related
Apologies for the vague title, but here is my issue. I have a form that has several select lists and associated text boxes. Basically the way it works is if you select a name from the first list, an AfterUpdate event is triggered to query the DB to see if the Eng_ID and Person_ID already exist in the table. If so, then delete that row then insert the updated row. If there is not any records, then just insert the data. The problem is that when I click a name in the first list, then move to the second list, what's happening is that the the Person_ID of the first list is used for the DLookup query, then it delets the record, then inserts the record of the new person I selected in a different listbox. The code is below: Thanks in advance
' Add/Remove Participant 1
Private Sub lstPar1_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar1
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 1 & ",'" & Me.txtParRole1.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
' Add/Remove Participant 2
Private Sub lstPar2_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar2
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role) " & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 2 & ",'" & Me.txtParRole2.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
Using this image, if I select Daniel and enter his role, then the eng_ID, Person_ID, ParticipantNumber and Role are entered into the database as 130, 118, 1, Collaborator.
If I select Kristin, it deletes Daniel becuause it's still using Person_ID of 118 instead of hers which is 134, and since there is a corresponding record, it delets Daniel then adds Kristin.
I don't have Access to test this with, but it seems like you need to separate Participant1 records from Participant2 records when you perform your DLookups.
Also you can generalize your code by pulling the common parts into a separate sub.
Private Sub lstPar1_AfterUpdate()
CheckParticipant Me.lstPar1, 1, Me.txtParRole1.Value
End Sub
Private Sub lstPar2_AfterUpdate()
CheckParticipant Me.lstPar2, 2, Me.txtParRole2.Value
End Sub
Sub CheckParticipant(objList As Object, participantNum As Long, role As String)
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With objList
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n) & _
" And ParticipantNumber=" & participantNum
strSQL = ""
If Not .Selected(n) Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & _
" VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & participantNum & _
",'" & role & "' )"
End If
End If
If Len(strSQL) > 0 Then CurrentDb.Execute strSQL, dbFailOnError
Next n
End With
End Sub
I think I need help with this one:
I look for a way to send a number of line items within a transaction to a database with as little coding as possible
A transaction can consist of 1 or several lineitems for a defined set of products (CategoryIDs). Each combination of CategoryIDs and LineItems is stored in a seperate row. Rows with 0 lineItems are to be ignored.
The products are listed in Worksheet-Column B, and the number of products purchased (the lineitem number) is stored in Column C
In addition, I have a CustomerID and a TransactionID, but these two values are "outside" of the loop because they are the same for the complete transaction, so they are not part of my question.
What I would like to accomplish is:
let the code loop through each row
ignore all rows with 0 line items
at a row with >0 line items, run an SQL insert containing the categoryID and the lineitems of that row
go to next row
I am not sure if this is at all possible in the way I try to do this:
Private Sub AbsendenNeu_Click()
Dim Cell As Range
'Variables for the connection to the SQL server
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim conStr As String
Dim strSQL As String
'variables "outside the loop" that I am not too concerned with in this question
Dim CustomerUniqueName As String
Dim TransactionID As String
CustomerUniqueName = Worksheets("Eingabe").CustomerSelect.Value
TransactionID = "1-" & CustomerUniqueName & Now()
'These are the two variables "in the loop"
Dim CatID As Range
Dim LineItems As Range
'Open the database connection
Set con = New ADODB.Connection
con.Open "Driver={ODBC Driver 17 for SQL Server};Server=tcp:my-servername,1433;Database=my-database;Uid=my-User;Pwd=My-Password;Encrypt=yes;TrustServerCertificate=no;Connection Timeout=30;"
'this is the loop I try to get to work
With Worksheets("EmissionenNeu") 'This is the worksheet that contains the CategoryIDs and LineItems
Set CatID = Range("B" & Cell.Row)
Set LineItems = Range("C" & Cell.Row)
For Each Cell In Range("C2:C39")
If Cell.Value > 0 Then
strSQL = "INSERT INTO tblTransactions(ShopID,TransactionID,CategoryID,CustomerUniqueName,LineItems) VALUES(1,'" & TransactionID & "','" & CatID & "', '" & CustomerUniqueName & "','" & LineItems & "');"
con.Execute strSQL
End If
Next Cell
con.Close
Set con = Nothing
' End With
End Sub
I read this example in a different context so I am not sure if I can adapt this to my case. I get an error at " Set CatID = Range("B" & Cell.Row) " that says "Object Variable or With-Block Variable not defined" (in German), which sounds pretty basic, and I have the feeling more problems might wait ahead. Is the route I am trying at all possible?
Thanks in advance.
Try something like this:
Private Sub AbsendenNeu_Click()
Dim Cell As Range, rw As Range
Dim con As ADODB.Connection
Dim strSQL As String
Dim CatID, LineItems
Dim CustomerUniqueName As String
Dim TransactionID As String
CustomerUniqueName = Worksheets("Eingabe").CustomerSelect.Value
TransactionID = "1-" & CustomerUniqueName & Now()
'Open the database connection
Set con = New ADODB.Connection
con.Open "Driver={ODBC Driver 17 for SQL Server};Server=tcp:my-servername,1433;" & _
"Database=my-database;Uid=my-User;Pwd=My-Password;Encrypt=yes;" & _
"TrustServerCertificate=no;Connection Timeout=30;"
'loop each row in the input range
For Each rw In Worksheets("EmissionenNeu").Range("B2:C39").Rows
CatID = rw.Cells(1).Value
LineItems = rw.Cells(2).Value
If Len(LineItems) > 0 Then
strSQL = "INSERT INTO tblTransactions(ShopID,TransactionID,CategoryID," & _
"CustomerUniqueName,LineItems) VALUES" & _
"(1,'" & TransactionID & "','" & CatID & "', '" & _
CustomerUniqueName & "','" & LineItems & "')"
con.Execute strSQL
End If
Next rw
con.Close
Set con = Nothing
End Sub
I have a table, which was pulled out of some XML data. I'm trying to do a cross reference, so I can line out a plan for organizing the data. This 1 table has a list of variables. Fields of different data types, computations, as well as dialogs. One of the columns has options. If the data type of the variable is a dialog, its options has a list of variables, separated by a semi-colon.
So the main table has a structure like so:
For the dialog records I need to look through their options column and insert records into a normalized table. For each field, in that column, I want to add a record with that dialog name, and the ID of the row in that table (I added a PK to the table). For instance, in the dialog record, Options column, there is a field in there called BusinessName TE. I need to search this main table for the PK ID of the row that has a variable name of the same. I need to put that record's ID with the name of the dialog, and insert both into a new table I set up. This will create a cross reference for me, so I can know which variables are being used by which dialogs.
I appreciate any help anyone can give. I see stuff about using a split function, arrays and looping through to get each value, but the examples I'm finding are for strings, not a column in a table.
Thanks!
Edit: Adding in the VBA code I'm working with. I attached it to a button on a form, just so I could click to run it.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [MASTER Fields].Options,[MASTER Fields].[Variable Name] FROM [MASTER Fields] WHERE ((([MASTER Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray) + 1
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
FieldName = DLookup("ID", "MASTER Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
End If
Next i
End If
rs.MoveNext
Loop
End Sub
right now on the line that says
If TestArray(i) <> "" Then
creates an error ""
If anyone can help, I'd really appreciate it!
Another Edit:
Parfait figured out my issue. I'm posting the final code I am using, in case it helps someone else! p.s. I added a condition to check if the dlookup is successful, and trap failures in a failures table. That way I can check those out afterward.
Private Sub RunParse_Click()
Dim db As DAO.Database
Dim rs As Recordset
Set db = CurrentDb()
Dim sqlStr, insertSQL, arrayVal As String
Dim TestArray As Variant
Dim Options As String
Dim Dialog As String
Dim FieldName As Long
Dim i As Integer
sqlStr = "SELECT [Master Fields].Options,[Master Fields].[Variable Name] FROM [Master Fields] WHERE ((([Master Fields].[Variable Type])='dialog'));"
Set rs = db.OpenRecordset(sqlStr)
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
Options = rs.Fields(0)
Dialog = rs.Fields(1)
If InStr(Options, ";") Then
TestArray = Split(Options, ";")
For i = 0 To UBound(TestArray) - LBound(TestArray)
If TestArray(i) <> "" Then
arrayVal = TestArray(i)
If Not (IsNull(DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'"))) Then
FieldName = DLookup("ID", "Master Fields", "[Variable Name] = " & "'" & arrayVal & "'")
insertSQL = "INSERT INTO FieldTemplatesUse(FID, TemplateAK) " _
& "VALUES(""" & FieldName & """, """ & Dialog & """)"
DoCmd.RunSQL (insertSQL)
'MsgBox "Adding ID = " & FieldName & "for Dialog: " & Dialog & "Now"
Else
insertSQL = "INSERT INTO tblFieldsNotFound(Dialog, FieldNotFound) " _
& "VALUES(""" & Dialog & """, """ & arrayVal & """)"
DoCmd.RunSQL (insertSQL)
End If
End If
Next i
End If
rs.MoveNext
Loop
MsgBox "All Done!"
End Sub
I am trying to create a new table where the field name in the source file is a variable. For example, the ID field in the source data could be "ID" or "HB_REF_NO", Date of birth may be DoB, Date of Birth or Date_of_birth
I've made a code that searches for various field names and returns the column they are in but am struggling to transfer the data from those columns into a table
Here is the code, please excuse its no doubt brutish methodology...
Private Sub cmdCompare_Click()
Set db = CurrentDb()
Set RecordSet1 = db.OpenRecordset("OriginalData")
Dim Fld As DAO.Field
Dim FldArray() As String
Dim i As Integer
Dim j As Integer
Dim SQLCreate As String
Dim SQLInsert As String
Dim s As Integer
Dim d As Integer
Dim b As Integer
Dim p As Integer
j = RecordSet1.Fields.Count - 1
ReDim FldArray(j)
'Assigns field names to the array
For Each Fld In RecordSet1.Fields
FldArray(i) = Fld.Name
i = i + 1
Next
For i = 0 To j
If FldArray(i) = "Surname" Then
s = i
Else
End If
Next
For i = 0 To j
If FldArray(i) = "HB_REF_NO" Then
d = i
Else
End If
Next
For i = 0 To j
If FldArray(i) = "NC_DATE_OF_BIRTH" Then
b = i
Else
End If
Next
For i = 0 To j
If FldArray(i) = "POSTCODE" Then
p = i
End If
Next
SQLCreate = "CREATE TABLE OriginalComp" & _
"(ID varchar(255), Surname varchar(255), DoB varchar(255), Postcode varchar(255))"
DoCmd.RunSQL SQLCreate
SQLInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"VALUES ('" & FldArray(d) & "','" & FldArray(s) & "','" & FldArray(b) & "','" & FldArray(p) & "');"
DoCmd.RunSQL SQLInsert
End Sub
It would be simpler to examine the source table's TableDef.Fields collection and find the current names for each of your variable field names. You don't need to open the table as a Recordset and you don't need to use an array.
This example will find and use a birth date field whose name matches either *Dob* or *Date*Birth*. (If more than one field in the table could match those patterns, you'll need to substitute patterns which are more selective.)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim strDateOfBirth As String
Dim strInsert As String
Set db = CurrentDb
Set tdf = db.TableDefs("OriginalData")
For Each fld In tdf.Fields
With fld
If .Name Like "*DoB*" Or .Name Like "*Date*birth*" Then
strDateOfBirth = .Name
End If
End With
Next
If Len(strDateOfBirth) > 0 Then
strInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"SELECT HB_REF_NO, Surname, [" & strDateOfBirth & "], POSTCODE " & _
"FROM OriginalData;"
Debug.Print strInsert '<- inspect this in Immediate window; Ctrl+g will take you there
db.Execute strInsert, dbFailOnError
Else
MsgBox "Birth date field not found!"
End If
Extend that example to deal with the HB_REF_NO vs. ID field.
The problem is here:
SQLInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"VALUES ('" & FldArray(d) & "','" & FldArray(s) & "','" & FldArray(b) & "','" & FldArray(p) & "');"
The FldArray variable is a list of all of the column names, so the dth entry will be the dth column name, which is why you are inserting column names instead of values!
If you want to insert into OriginalComp those values then why not do:
Private Sub cmdCompare_Click()
Set db = CurrentDb()
SQLCreate = "CREATE TABLE OriginalComp" & _
"(ID varchar(255), Surname varchar(255), DoB varchar(255), Postcode varchar(255))"
DoCmd.RunSQL SQLCreate
SQLInsert = "INSERT INTO OriginalComp (ID, Surname, DoB, Postcode) " & _
"SELECT HB_REF_NO, Surname, NC_DATE_OF_BIRTH, POSTCODE " & _
"FROM OriginalData"
DoCmd.RunSQL SQLInsert
End Sub
I tried to translate a code from VBA excel to access. My data is a column of prices and I want to compute the returns.
This is the original VBA code in excel:
DerCol = Cells(T.Row, Columns.Count).End(xlToLeft).Column
Cells(T.Row, DerCol + 1) = "Returns"
For i = T.Row + 2 To T.End(xlDown).Row
Cells(i, DerCol + 1) = Application.WorksheetFunction.Ln(Cells(i, T.Column)) - Application.WorksheetFunction.Ln(Cells(i - 1, T.Column))
Next i
To get an idea of the output that I have in excel, click here.
In Access, I created a new column next to the prices' column and I would like to fill in exactly like in excel:
Sub vardaily()
Dim db As Database, T As Object, DerCol As Integer, y As TableDef
Dim rs As DAO.Recordset, i As Integer, strsql As String
'idea = SELECT prices FROM dailypricing, then creates newtable "VAR", copy and prices, compute historical and parametric VAR '
'create a new table var_daily'
Set db = CurrentDb()
'insert the pricing date and the prices from dbo_daily'
db.Execute "CREATE TABLE VAR_daily" _
& "(PricingDate CHAR, Price Number);"
'where clause to select the same traded product only'
db.Execute " INSERT INTO VAR_daily " _
& "SELECT PricingDate, Price " _
& "FROM dbo_PricingDaily " _
& "WHERE IndexId = 1;"
db.Execute " ALTER TABLE VAR_daily " _
& "ADD COLUMN Returns Number;"
'sql request to store prices'
strsql = "SELECT First(Price) as FirstPrice, Last(Price) as EndPrice FROM VAR_daily;"
'dao.recordset of the store prices'
Set rs = db.OpenRecordset(strsql, dbOpenDynaset)
'loop to change the prices'
For i = 2 To i = rs.RecordCount
rs.Edit
rs!Price(i) = Log(rs!Price(i)) - Log(rs!Price(i - 1))
rs.Update
Next i
db.Execute "INSERT INTO VAR_daily " _
& "(Returns) VALUES " _
& "(" & rs![Price] & ");"
End Sub
I have the following table that you can see here
I can not manage with the loop. I have no item in my collection at the end.
I looked at other example of loops like here but I did not find how to make an iteration with the last result.
Sorry, I really am a beginner in Ms Access and SQL. I started this week so I apologize if my question is very basic.
EDIT: I added the images and I replaced Firsttransaction and Lasttransaction by "FirstPrice" and "EndPrice".
EDIT2: Thanks to my new privilege, I can share a sample for those who are interested.
I have updated your complete code to what it should be. Again, I don't have an Access database handy to test it but it compiles and should work:
Sub vardaily()
Dim db As Database
Dim rs As DAO.Recordset, i As Integer, strsql As String
Dim thisPrice, lastPrice
'idea = SELECT prices FROM dailypricing, then creates newtable "VAR", copy and prices, compute historical and parametric VAR '
'create a new table var_daily'
Set db = CurrentDb()
'insert the pricing date and the prices from dbo_daily'
db.Execute "CREATE TABLE VAR_daily" _
& "(PricingDate CHAR, Price Number);"
'where clause to select the same traded product only'
db.Execute " INSERT INTO VAR_daily " _
& "SELECT PricingDate, Price " _
& "FROM dbo_PricingDaily " _
& "WHERE IndexId = 1 " _
& "ORDER BY PricingDate;"
db.Execute " ALTER TABLE VAR_daily " _
& "ADD COLUMN Returns Number;"
'sql request to retrieve store prices'
strsql = "SELECT * FROM VAR_daily ORDER BY PricingDate;" ' just get all fields
'dao.recordset of the store prices'
Set rs = db.OpenRecordset(strsql, dbOpenDynaset)
'loop to change the prices'
lastPrice = rs.Fields("Price") ' get price from first record and remember
rs.MoveNext ' advance to second record and start loop
While (Not rs.EOF())
thisPrice = rs.Fields("Price")
rs.Edit
rs!Returns = Log(thisPrice) - Log(lastPrice)
rs.Update
lastPrice = thisPrice ' remember previous value
rs.MoveNext ' advance to next record
Wend
End Sub