I am trying to create a change log anytime a field is changed. I want it to record the property, the manager, and the date it was changed. I looked up INSERT INTO and followed the directions and came up with this code, but I get an error.
Private Sub Manager_AfterUpdate()
INSERT INTO tbl_ManagerChangeLog (Property, NewMan, [Date Change])
VALUES (Me.ID, Me.Manager, DATE())
End Sub
There error I get reads, "Compile Error: Expected: End of statement"
Any help is appreciated.
Here is final code that worked for me. Thank you for all of the help.
Private Sub Manager_Change()
Dim dbs As Database, PropID As Integer, ManNam As String, ChangeDate As Date
Set dbs = CurrentDb()
PropID = Me.ID
ManNam = Me.Manager
ChangeDate = Date
dbs.Execute " INSERT INTO tbl_ManagerChangeLog " & "(Property, NewMan, DateChange)VALUES " & "(" & PropID & ", " & ManNam & ", #" & ChangeDate & "#);"
End Sub
You must run a SQL query using Execute funcion from currentDb object, and build the query values concatenating values:
Private Sub Manager_AfterUpdate()
Dim sSQL as String
sSQL = "INSERT INTO tbl_ManagerChangeLog (Property, NewMan, [Date Change]) " & _
"VALUES (" & Me.ID & ",'" & Me.Manager "'," & _
"#" & format(DATE(),"YYYY-MM-DD HH:NN:SS") & "#)"
currentDB.Execute sSQL
End Sub
Try the following VBA to run a sql query.
Private Sub Manager_AfterUpdate()
Dim strSql As String , Db As dao.Database
strSql = "INSERT INTO tbl_ManagerChangeLog (Property, NewMan, [Date Change]) VALUES (Me.ID, Me.Manager, DATE());"
'Use Current Database
Set Db = CurrentDb()
'Run the SQL Query
Db.Execute strSql
End Sub
Related
Good morning,
I am helping to develop an interface via a Form in MS Access. We have a list box with various user values and the user should be able to select multiple values in the ListBox and then press the button to execute a query, returning only the rows whose Car Name is what was selected.
UPDATE - thanks to some great feedback on this forum, the primary issue was resolved. My secondary issue is now not being able to execute the query. When I try, I get the error that the query cannot be executed.
My code (as event procedure) for the button is:
Option Explicit
Private Sub btnSearchCars_Click()
MsgBox "Starting Sub"
Call QueryCars.myQuery
MsgBox "Ending Sub"
End Sub
Then, my QueryCars module looks like this:
Sub myQuery()
Dim strWhere As String
Dim strSQL As String
Dim varItem As Variant
For Each varItem in Forms!FormSelect!listCarID.SelectedItems
strWhere = strWhere & "'" & Forms!FormSelect!listCarID.ItemData(varItem) & "',"
Next
strWhere = Left(strWhere, Len(strWhere) -1)
strSQL = "SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & strWhere & ");"
DoCmd.RunSQL strSQL
End Sub
My error is an "A RunSQL requires an argument of an SQL statement" error on the line.
DoCmd.RunSQL strSQL
I would really appreciate it if someone could help. All I am trying to do is take the values from the list box the user selects and use them as WHERE criteria in my query. I have searched various SO and Access forums all morning and have not found anything to help.
Thank you. Please let me know if you have any questions.
This isn't the perfect answer I was hoping to give you - but can't figure out how to use parameter queries in an IN command.
I'll assume that your listbox contains two columns of data and the CarID values are in the first column.
The main function is called ProcessQuery and accepts a reference to the listbox as an argument:
Public Sub ProcessQuery(myList As ListBox)
You can then call your code from the event on the listbox and pass it the listbox reference.
Private Sub btnSearchCars_Click()
ProcessQuery Me.listCarID
End Sub
The ProcessQuery procedure then looks at the first column to get the index numbers, constructs the SQL, opens the resulting recordset and pulls the info from each record.
Public Sub ProcessQuery(myList As ListBox)
Dim vItem As Variant
Dim IDList As String
Dim qdf As dao.QueryDef
Dim rst As dao.Recordset
For Each vItem In myList.ItemsSelected
'Column 0 is first column in listbox.
IDList = IDList & "'" & myList.Column(0, vItem) & "',"
Next vItem
'Removes the final ,
IDList = Left(IDList, Len(IDList) - 1)
'Create a temporary query definition & open the recordset.
Set qdf = CurrentDb.CreateQueryDef("", _
"SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & IDList & ")")
Set rst = qdf.OpenRecordset
'Move through the recordset and output the first two fields from each record
'to the Immediate window.
With rst
If Not (.BOF And .EOF) Then
.MoveFirst
Do While Not .EOF
Debug.Print .Fields(0) & " - " & .Fields(1)
.MoveNext
Loop
End If
End With
End Sub
To display the query result as a datasheet you could use the following, but I'd prefer to use a stored query with a parameter for the IN. I'll try and figure that bit out.
Public Sub ProcessQuery(myList As ListBox)
Dim vItem As Variant
Dim IDList As String
Dim qdf As dao.QueryDef
Dim rst As dao.Recordset
For Each vItem In myList.ItemsSelected
'Column 0 is first column in listbox.
IDList = IDList & "'" & myList.Column(0, vItem) & "',"
Next vItem
'Removes the final ,
IDList = Left(IDList, Len(IDList) - 1)
'Create a temporary query definition & open the recordset.
Set qdf = CurrentDb.CreateQueryDef("TempQDF", _
"SELECT tblBig.* FROM tblCars INNER JOIN tblBig ON tblCars.Car_ID = tblBig.Car_ID WHERE tblCars.Car_ID IN (" & IDList & ")")
DoCmd.OpenQuery "TempQDF", acViewNormal
End Sub
I would suggest first taking a look at the actual WHERE clause being generated...keep a separate string variable to store it, and then dump it to the Immediate Window when it's generated.
I would also suggest creating a separate function to return values selected in a list box as an array. Something like:
Public Function getListBoxSelection(ctl As Access.ListBox) As Variant
Dim arr() As Variant
Dim varItem As Variant, i As Long
If ctl.ItemsSelected.Count > 0 Then
ReDim arr(0 To ctl.ItemsSelected.Count - 1)
i = 0
For Each varItem In ctl.ItemsSelected
arr(i) = ctl.ItemData(varItem)
i = i + 1
Next varItem
End If
getListBoxSelection = arr
End Function
Then, you would call it in SQL generation. Something like
whereClause = join(getListBoxSelection(me.listCarID), " AND ")
debug.Print whereClause
qdf.SQL = _
"select tblBig.* " & _
"from tblCars " & _
"inner join tblBig on tblCars.Cat_ID = tblBig.Car_ID " & _
"where tblCars.Card_ID in (" & whereClause & ")"
Help! i am having some trouble with my access codes on a database whereby it says that access error 3061 Too Few parameters expected 1. Problem highlighted was
Set oRS = CurrentDb.OpenRecordset(sSQL)
Dim i As Date, n As Integer, oRS As DAO.Recordset, sSQL As String
Dim db As DAO.Database
Set db = CurrentDb
Dim BookedDate As Date
Dim FacilitiesID As String
Dim StartTime As Date
cboTime.RowSourceType = "Value List"
cboTime.RowSource = ""
If IsNull(Start) Then Exit Sub Else i = Start
If Me.NewRecord = True Then
DoCmd.RunCommand acCmdSaveRecord
End If
sSQL = "SELECT FacilitiesID, StartTime, BookedDate"
sSQL = sSQL & " FROM qrysubform"
sSQL = sSQL & " WHERE FacilitiesID= " & Me.FacilitiesID & _
" AND BookedDate=# " & Me.txtDate & "#"
Set oRS = CurrentDb.OpenRecordset(sSQL)
Your Facilities ID is dimensioned as a string, though in your SQL statement it is referenced as a number. If your form's FacilitiesID is in fact a string, you need to enclose it in quotes:
sSQL = "SELECT FacilitiesID, StartTime, BookedDate"
sSQL = sSQL & " FROM qrysubform"
sSQL = sSQL & " WHERE FacilitiesID= '" & Me.FacilitiesID & _
"' AND BookedDate=#" & Me.txtDate & "#"
In such cases, insert a debug line and study the output:
Debug.Print sSQL
' Study output
Set oRS = CurrentDb.OpenRecordset(sSQL)
That said, this error is typically caused by a missing or misspelled field name.
Error: "Run-time error '3061' Too few parameters. Expected 2.
I wrote this simple function that returns the remaining percentage calculated for number of records changed. It is supposed to occur when the user updates the field called 'percentage' I am certain the code below should work, but obviously something is wrong. It occurs on the line:
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
I wonder how it could fail when the very same query is what populates the 'record source' for the form with the 'percentage' textbox.
Function RemainingPercentAvailable() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
Dim CurrentTotal As Single
CurrentTotal = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
CurrentTotal = CurrentTotal + rs!Percentage
rs.MoveNext
Loop
End If
RemainingPercentAvailable = "Remaing available: " & Format(1 - CurrentTotal, "0.000%")
Set rs = Nothing
Set db = Nothing
End Function
Adapt your code to use the SELECT statement with a QueryDef, supply values for the parameters, and then open the recordset from the QueryDef.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Tier1, [Percentage], Tier3 AS Battalion, [Month] " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND (([Month])=[Forms]![frmEntry]![cmbMonth]));"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL )
' supply values for the 2 parameters ...
qdf.Parameters(0).Value = Eval(qdf.Parameters(0).Name)
qdf.Parameters(1).Value = Eval(qdf.Parameters(1).Name)
Set rs = qdf.OpenRecordset
Note: Month is a reserved word. Although that name apparently caused no problems before, I enclosed it in square brackets so the db engine can not confuse the field name with the Month function. It may be an unneeded precaution here, but it's difficult to predict exactly when reserved words will create problems. Actually, it's better to avoid them entirely if possible.
This one is calling a query directly in a DAO.Recordset and it works just fine.
Note the same 'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) This is a parameter SQL as well.
The only difference is with this one is that I DIDN'T need to move through and analyze the recordset - but the error occurs on the 'Set rs = " line, so I wasn't able to get further anyway.
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
strSQL = "SELECT Sum(tbl_SP.AFP) AS AFP_TOTAL, tbl_SP.T1_UNIT " _
& "FROM tbl_SP " _
& "GROUP BY tbl_SP.T1_UNIT " _
& "HAVING (((tbl_SP.T1_UNIT)='" & strUnit & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
AFP_Total = rs!AFP_Total
There is an even simpler way to calculate the total percentage.
Instead of looping through the records, you can use the DSum() function.
Note that DSum will return Null if there are no records, so you need to wrap it in Nz().
Just for fun, here is your function but written as one single statement:
Function RemainingPercentAvailable() As String
RemainingPercentAvailable = "Remaining available: " & Format(1 - _
Nz(DSum("Percentage", _
"tbl_CustomPercent", _
"Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth))) _
, "0.000%")
End Function
I don't recommend building a temporary parameterized query in VBA, because it makes the code too complicated. And slower. I prefer to build "pure" SQL that will run directly in the db engine without any callbacks to Access. I'm assuming that your function is defined in the frmEntry form, and that cmbImport_T1 and cmbMonth are string fields. If they are numeric, omit qString().
Here is my version of your function. It handles the empty-recordset case correctly.
Function RemainingPercentAvailable() As String
Dim CurrentTotal As Double, q As String
q = "SELECT Percentage" & _
" FROM tbl_CustomPercent" & _
" WHERE Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth)
CurrentTotal = 0
With CurrentDb.OpenRecordset(q)
While Not .EOF
CurrentTotal = CurrentTotal + .Fields("Percentage")
.MoveNext
Wend
End With
RemainingPercentAvailable = "Remaining available: " & _
Format(1 - CurrentTotal, "0.000%")
End Function
' Return string S quoted, with quotes escaped, for building SQL.
Public Function QString(ByVal S As String) As String
QString = "'" & Replace(S, "'", "''") & "'"
End Function
Can anyone help as I am struggling to finish the end result:
I got an unbound mainform, got an bound subform, got two tables Masterplant and PlantTransaction.
When I edit a record it shows on the mainform and when I save the record it must duplicate an existing record in the subform, which works, but the trick is that the Opening Hours in the new record must become my Closing Hours of the previous record, everything works it's just the Opening Hours does not show from the Closing hours previous record and the TransactionID is a number field that must auto increment with a different TransactionID number. Any help will be appreciated, thanks in advance!!!
Code below:
Private Sub cmdSave_Click()
Dim strSQL As String
Dim rst As DAO.Recordset
If IsNull(txtOpeningHRS) Then
Set rst = Me.RecordsetClone
If rst.RecordCount > 0 Then
If Me.NewRecord Then
rst.MoveLast
Else
rst.Bookmark = Me.Bookmark
rst.MovePrevious
End If
txtOpeningHRS = rst!CloseHrs
End If
End If
If IsNull(Me.TransactionID) Or Me.TransactionID = 0 Then
Me.TransactionID = Nz(DMax("TransactionID", "PlantTransaction") + 1, 1234)
End If
strSQL = "INSERT INTO PlantTransaction(TransactionID, [Plant Number], Opening_Hours,
[TransactionDate], [FuelConsumption], [Hour Meter Replaced], Comments, [Hours Worked]) & _
strSQL & "VALUES(" & Me.txtTranID & ",'" & Me.txtPlantNo & "','" & Me.txtOpeningHRS & "',#" &
Me.txtTransDate & "#,'" & Me.txtFuelConsFuelHr & "','" & Me.txtHrMtrRep & "','" & Me.txtComments
& "','" & Me.txtHrsWorked & "');"
CurrentDb.Execute strSQL
Me.PlantTransactionQuery.Form.Requery
cmdNew_Click
End Sub
Set TransactionID to be an AutoNumber data type, this will automatically increment it.
You can also try replacing:
CurrentDb.Execute strSQL
Me.PlantTransactionQuery.Form.Requery
with:
CurrentDb.Execute strSQL
Me!PlantTransactionQuery.Form.RowSource = "Select * from PlantTransaction"
Me.PlantTransactionQuery.Form.Refresh
I am making a rather simple inventory tracking database. And I want to retrieve the record by ID, and add or remove the specified number to the amount. If it doesn't exist I want to add it. Is it even possible to do this without binding to a table?
Sounds like you have a candidate ID value. Maybe it's contained in a numeric variable named MyID. And you have another numeric value, MyAmtChange, which is to be added to the value in a field named amount in your table for the row where the ID field value matches MyID.
A complication is there may be no row in your table whose ID value matches MyID. In that case, you need to add a row for it.
If that's correct, INSERT a row for MyID when one doesn't exist. Then you can simply UPDATE the amount in the row which matches MyID.
Dim strInsert As String
Dim strUpdate As String
Dim db As DAO.Database
Set db = CurrentDb
If DCount("*", "YourTableNameHere", "ID = " & MyID) = 0 Then
strInsert = "INSERT INTO YourTableNameHere (ID)" & vbCrLf & _
"VALUES (" & MyID & ");"
Debug.Print strInsert
db.Execute strInsert, dbFailOnError
End If
strUpdate = "UPDATE YourTableNameHere" & vbCrLf & _
"SET amount = Nz(amount, 0) + " & MyAmtChange & vbCrLf & _
"WHERE ID = " & MyID & ";"
Debug.Print strUpdate
db.Execute strUpdate, dbFailOnError
Set db = Nothing
If this guess is reasonably close, add an error handler block to that code to deal with any issues surfaced by dbFailOnError ... or any other errors.
I don't know what do you want exactly, but this code show how to manipulate data with VB-Access.
Sub fnStudent()
On Error GoTo insertError
Dim studentQuery As String
'INSERTING INTO TABLE
studentQuery = "INSERT INTO Students values ('10','YAHYA','02/10/2012')"
CurrentDb.Execute studentQuery, dbFailOnError
'UPDATING
studentQuery = "UPDATE Students Set name='YAHYA OULD ABBA' WHERE stdID='10'"
CurrentDb.Execute studentQuery, dbFailOnError
'LISTING VALUES
Dim studentsRS As Recordset
Set studentsRS = CurrentDb.OpenRecordset("SELECT * FROM Students WHERE upper(name) like '%YAHYA%';")
Do While Not studentsRS.EOF
MsgBox "ID : " & studentsRS.Fields(0) & "Name : " & studentsRS.Fields(1) & "Birth Date : " & studentsRS.Fields(2)
studentsRS.MoveNext
Loop
'DELETING
studentQuery = "DELETE FROM Students WHERE stdID='10'"
CurrentDb.Execute studentQuery, dbFailOnError
Exit Sub 'exit if there was no error
'UPDATE:
errorHandler:
If Err.Number = 3022 Then
MsgBox "Can't have duplicate key; index changes were unsuccessful", vbMsgBoxRtlReading + vbCritical, "Error " & Err.Number
Else : MsgBox "Error" & vbCrLf & Err.Description, vbMsgBoxRtlReading + vbCritical, "Error " & Err.Number
End If
End Sub
here you find a list of vba errors http://www.halfile.com/vb.html