Updating a date record in a table using VBA & cmd button - ms-access

I'm trying to get a Command Button to update a date on a table. The button is in a separate form. Right now I'm trying:
Private Sub Command13_Click()
Update Master
Set [Last Complete] = Date()
End Sub
"Master" being the table I'm trying to update and "Last Complete" being the specific record.
Access throws an error message with my code, complaining "sub or function isn't properly defined".
I've worked quite a bit with VBA in Excel but not so much with Access.

The problem is that a SQL statement is not valid VBA code.
You can place the statement in a string and use the DAO.Database.Execute method to execute it:
Private Sub Command13_Click()
CurrentDb.Execute "Update Master Set [Last Complete] = Date()"
End Sub
Assuming that UPDATE statement is valid and does what you want, that could be all you need. However, here is another version which demonstrates features you may find useful:
Private Sub Command13_Click()
Dim db As DAO.Database
Dim strUpdate As String
strUpdate = "Update Master Set [Last Complete] = Date()"
Debug.Print strUpdate
Set db = CurrentDb
db.Execute strUpdate, dbFailOnError
Debug.Print db.RecordsAffected & " rows updated"
Set db = Nothing
End Sub

Related

How to properly use Seek in DAO database

I'm trying to search for currently selected item in my listbox control on my table.
In my listbox control after update event, I have this code
Private Sub lst_MainList_AfterUpdate()
Dim theDB As DAO.Database
Dim theProposalsTable As DAO.Recordset
Set theDB = CurrentDb
Set theProposalsTable = theDB.OpenRecordset("tbl_PROPOSAL", dbOpenDynaset)
theSeeker theProposalsTable, Me.lst_PPpg_MainList.Value
End Sub
Then I have a sub on my Module1 with this code. I got this from an example code # https://msdn.microsoft.com/en-us/library/office/ff836416.aspx
Sub theSeeker(ByRef rstTemp As Recordset, intSeek As Integer)
Dim theBookmark As Variant
Dim theMessage As String
With rstTemp
' Store current record location.
theBookmark = .Bookmark
.Seek "=", intSeek
' If Seek method fails, notify user and return to the
' last current record.
If .NoMatch Then
theMessage = "Not found! Returning to current record." & vbCr & vbCr & "NoMatch = " & .NoMatch
MsgBox theMessage
.Bookmark = theBookmark
End If
End With
End Sub
I am getting Runtime Error 3251 Operation is not supported for this type of object.
When I hit Debug, it highlights .Seek "=", intSeek
In this point from the linked page ...
Locates the record in an indexed table-type Recordset object
... "table-type Recordset" means you must use dbOpenTable instead of dbOpenDynaset with OpenRecordset()
That point is critical. If you can't open the table with dbOpenTable, you can't use Seek. And dbOpenTable can only be used with native Access tables contained in the current database. It can not be used with any kind of linked table.
So if dbOpenTable is compatible with tbl_PROPOSAL, this change will eliminate the first error ...
'Set theProposalsTable = theDB.OpenRecordset("tbl_PROPOSAL", dbOpenDynaset)
Set theProposalsTable = theDB.OpenRecordset("tbl_PROPOSAL", dbOpenTable)
If that does work, the next error will be #3019, "Operation invalid without a current index." That happens because you must set the controlling index before calling Seek ...
With rstTemp
' Store current record location.
theBookmark = .Bookmark
' Set the index.
.Index = "PrimaryKey" '<- use your index name here
.Seek "=", intSeek
If you need to list the names of your table's indexes, you can examine its TableDef.Indexes collection. Here is an Immediate window example with a table in my database ...
set db = CurrentDb
for each idx in db.TableDefs("tblFoo").Indexes : ? idx.name : next
id
PrimaryKey
You can't use the Seek method on a linked table because you can't open linked tables as table-type Recordset objects...
However, you can use the Seek method if you use the OpenDatabase method to open the backend database.
So instead of:
Set theDB = CurrentDb()
Do this:
Set theDB = OpenDatabase("full path to backend database")
Set theProposalsTable = theDB.OpenRecordset("tbl_PROPOSAL", dbOpenTable)
Allow me to combine these two old answers. Yes, you get an error when opening a linked table as dbOpenTable because that is only supported on tables local to the DB object you are working on. Like David pointed out, you can open the linked backend as a DB object and use that.
I'm using a reliable table in my back-end called "Settings". If you don't have a reliable table you can use to pull the back end you can pass in the table name as an argument.
I'm storing the backend object once I have a handle on it so we can call against it rapidly throughout our code without recreating the object.
Private thisBEDB As Database
'#Description("This allows us to call directly against linked tables.")
Public Function thisBackend() As Database
' For MS-ACCESS table
If (thisBEDB Is Nothing) Then
With DBEngine
Set thisBEDB = .OpenDatabase(Mid(CurrentDB.TableDefs("Settings").Connect, 11), False, False, "")
End With
End If
Set thisBackend = thisBEDB
End Function
Now we can use the backend handle to make the code in your example work as expected.
Private Sub lst_MainList_AfterUpdate()
Dim theDB As DAO.Database
Dim theProposalsTable As DAO.Recordset
Set theDB = CurrentDb
Set theProposalsTable = thisBackend.OpenRecordset("tbl_PROPOSAL", dbOpenTable)
theSeeker theProposalsTable, Me.lst_PPpg_MainList.Value
End Sub
Sub theSeeker(ByRef rstTemp As Recordset, intSeek As Integer)
Dim theBookmark As Variant
Dim theMessage As String
With rstTemp
.Index = "PrimaryKey"
' Store current record location.
theBookmark = .Bookmark
.Seek "=", intSeek
' If Seek method fails, notify user and return to the
' last current record.
If .NoMatch Then
theMessage = "Not found! Returning to current record." & vbCr & vbCr & "NoMatch = " & .NoMatch
MsgBox theMessage
.Bookmark = theBookmark
End If
End With
End Sub

Run Time Error 3464: Data Type Mismatch in criteria expression

I have a form in Access 2010 with Two text boxes(AIPIDTxt to enter the search criteria and AIPResultTxt to display results) and a Button(Search button). I also have a Table Table1 in Access. When I click the Search Button, I need to execute a query whose criteria is in AIPIDTxt Textbox in the form, store the result in a recordset and display the results in the textbox AIPResultTxt. So I typed in the following VBA Code in the Button Event handler.
Private Sub SearchB_Click()
Dim localConnection As ADODB.Connection
Dim query As String
Dim aipid_rs As ADODB.Recordset
Dim db As Database
Set db = CurrentDb
Set localConnection = CurrentProject.AccessConnection
MsgBox "Local Connection successful"
query = "SELECT [AIP Name] FROM [Table1] WHERE [AIP ID]=
" & [Forms]![AIPIDSearchF]![AIPIDTxt] & ""
Set aipid_rs = db.OpenRecordset(query)
Me.AIPResultTxt.Text = aipid_rs![AIP Name]
End Sub
But when I click the button I get Local Connection Successful Message Box and then a Run Time Error 3464 in the line:
Set aipid_rs= db.OpenRecordset(query)
I have searched for similar errors and made corrections. But the error keeps coming. Is there something wrong with my query? Couldn't figure out the error. The table is a local table. So I can directly give [Table1] and field names in the query in vba. Tried adding delimiters because the fields are text fields. But that didn't work as well. I could not give the following query as well:
query = "SELECT [AIP Name] FROM [Table1] WHERE [AIP ID]= " & [Forms]![AIPIDSearchF]!
[AIPIDTxt].Text & ""
This gave me a run time error stating text cannot be referenced from controls that have lost focus. My criteria is text in the text box. The text box loses focus when i click the button. But when I googled for the error, solutions were to remove ".Text". So, I ended up with the above query. Do not know what is wrong with the line:
Set aipid_rs= db.OpenRecordset(query)
I suspect you have more than one problem with that code. But Access complains about only the first problem it finds. Look again at these 2 lines ...
Dim aipid_rs As ADODB.Recordset
Set aipid_rs = db.OpenRecordset(query)
OpenRecordset is a DAO method which returns a DAO recordset. But the code attempts to assign it to aipid_rs which was declared As ADODB.Recordset. Those recordset types are not compatible.
There is an ADO connection object variable, localConnection, which is not used for anything later. Although it doesn't trigger an error, it's just not useful. And actually I don't see any reason to use anything from ADO for this task.
I suggest you try this version of your code ...
'Dim localConnection As ADODB.Connection
'Dim query As String ' query is a reserved word
Dim strQuery As String
'Dim aipid_rs As ADODB.Recordset
Dim aipid_rs As DAO.Recordset
Dim db As Database
Set db = CurrentDb
'Set localConnection = CurrentProject.AccessConnection
'MsgBox "Local Connection successful"
' you said [AIP ID] is text type, so include quotes around
' the text box value
strQuery = "SELECT [AIP Name] FROM [Table1] WHERE [AIP ID]= '" & _
[Forms]![AIPIDSearchF]![AIPIDTxt] & "'"
Debug.Print strQuery
DoCmd.RunCommand acCmdDebugWindow
Set aipid_rs = db.OpenRecordset(strQuery)
'Me.AIPResultTxt.Text = aipid_rs![AIP Name] ' .Text property is only
' available when control has focus; it will trigger
' an error at any other time
Me.AIPResultTxt.Value = aipid_rs![AIP Name]
Note Debug.Print strQuery will display the text of the SELECT statement in the Immediate window, and DoCmd.RunCommand acCmdDebugWindow opens the Immediate window. If you still have a problem with the query, copy the statement text and paste it into SQL View of a new query for testing.
Finally I'm curious whether this might give you what you need with much less code ...
Private Sub SearchB_Click()
Me.AIPResultTxt.Value = DLookup("[AIP Name]", "Table1", _
"[AIP ID]='" & Me.AIPIDTxt & "'")
End Sub
You are using an ADO recordset, therefore your open syntax is incorrect. The following should work for you (except you may get an error setting the text if the control doesn't have focus...)
Dim localConnection As ADODB.Connection
Dim query As String
Dim aipid_rs As ADODB.Recordset
Dim db As Database
Set db = CurrentDb
Set localConnection = CurrentProject.AccessConnection
MsgBox "Local Connection successful"
query = "SELECT [AIP Name] FROM [Table1] WHERE [AIP ID]= '" & [Forms]![AIPIDSearchF]![AIPIDTxt] & "'"
'Set aipid_rs = db.OpenRecordset(query)
Set aipid_rs = New ADODB.Recordset
aipid_rs.Open query, localConnection, adOpenStatic, adLockReadOnly
If Not aipid_rs.EOF Then
Me.AIPResultTxt.Text = aipid_rs![AIP Name]
Else
MsgBox "No records!!"
End If
aipid_rs.Close
Set aipid_rs = Nothing
localConnection.Close
Set localConnection = Nothing
db.Close
Set db = Nothing
OK, So I have been searching for a simple search element for quite awhile...
I have tried using subforms and I have tried recordsets. All of these have given me the information. But not the compactness I was looking for, thanks!!!
using the DOA stuf is great but not for my application.
using the above:
Me.AIPResultTxt.Value = DLookup("[AIP Name]", "Table1", _
"[AIP ID]='" & Me.AIPIDTxt & "'")
I have the compactness of code I was looking for...
THanks!!!
T

Updating a field for an entire table via VBA

I am trying to add a received date to my table for all the files imported. We receive files and process them up to a week later. I have my import set up and everything but I added a column called "Receive Date". I also added a Date Picker and have it setup in VBA to grab it. I am not sure how to change ALL the records in the table to be the date selected.
Private Sub Command2_Click()
Dim Rec As String
Rec = Text0
End Sub
As you can tell I am just starting this but I do not know which direction I should be going from here. I would assume call the record set and table but I am unsure. Any assistance would be greatly appreciated. Thanks in advance
Sounds like you want the [Receive Date] in all rows of your table set to the date value selected in your Text0 text box. If that is correct, you can execute a SQL UPDATE statement from Command2_Click().
Private Sub Command2_Click()
Dim strUpdate As String
Dim db As DAO.database
Dim qdf As DAO.QueryDef
strUpdate = "PARAMETERS which_date DateTime;" & vbCrLf & _
"UPDATE YourTable" & vbCrLf & _
"Set [Receive Date] = which_date;"
Debug.Print strUpdate
Set db = CurrentDb
Set qdf = db.CreateQueryDef("", strUpdate)
qdf.Parameters("which_date") = Me.Text0
qdf.Execute dbFailOnError
Set qdf = Nothing
Set db = Nothing
End Sub

Microsoft Access Sub Form Write Conflict Troubles

I have a form which contains a subform which displays editable fields linked to one my tables. For a project I'm currently working on, one of the requirements is that I have to track when the last change was made to a record and who did so.
So what I've done is for each editable textbox or combobox within the form and subform I've made it so they have events on their BeforeUpdate and AfterUpdate events.
For example my BeforeUpdate for a textbox:
Private Sub textbox_BeforeUpdate(Cancel As Integer)
If Not isValidUser Then
Cancel = True
Me.textbox.Undo
End If
End Sub
and my AfterUpdate is:
Private Sub textbox_AfterUpdate()
updateRecord Me.textbox.Value, UserNameWindows
End Sub
and updateRecord is:
Public Sub updateRecord(bucNumber As String, updater As String)
Dim Dbs As Object
Dim rst As Object
Dim fldEnumerator As Object
Dim fldColumns As Object
sqlStatement = "SELECT fName " & _
"FROM t_Staff " & _
"WHERE uName='" & updater & "';"
'Getting fullname of user via username
Set rst = CurrentDb.OpenRecordset(sqlStatement)
'Setting fullname to updater variable
updater = rst(0)
'Clean Up
Set rst = Nothing
'Opening Bucket Contents
Set Dbs = CurrentDb
Set rst = Dbs.OpenRecordset("Bucket Contents")
Set fldColumns = rst.Fields
'Scan the records from beginning to each
While Not rst.EOF
'Check the current column
For Each fldEnumerator In rst.Fields
'If the column is named Bucket No
If fldEnumerator.Name = "Bucket No" Then
'If the Bucket No of the current record is the same as bucketNumber
If fldEnumerator.Value = bucNumber Then
'Then change the updated fields by updater and todays date
rst.Edit
rst("Last Updated By").Value = updater
rst("Last Updated On").Value = Date
rst.Update
End If
End If
Next
'Move to the next record and continue the same approach
rst.MoveNext
Wend
'Clean Up
Set rst = Nothing
Set Dbs = Nothing
End Sub
Okay now is the weird thing, this works totally fine when I make a modification to a control within the Main form, however as soon as a try to alter something in the subform it throws up a write conflict.
If I opt to save record it ignores my code for updating who last modified it and when and if I opt to discard the change it runs my code and updates it that it has been changed!
Anyone know what is wrong or of a better way to do this?

VBA and Access Form Filter

I have this form in access, the purpose of it is to work as a front end of a table which can be edited through this form. Initially when it loads I display in the form data from a recordset with the following query:
SELECT * FROM DATA
I want to be able to filter the data on the recordset once the form is open. I tried the following VBA code to accomplish this:
Private Sub Filter_Click()
If (IsNull(Me.Find_Field) Or Me.Find_Field = "") Then
rs.Close
Set rs = db.OpenRecordset("Select * from DATA ORDER BY ID)
rs.MoveFirst
LoadData (True)
Exit Sub
End If
Set rs = db.OpenRecordset("Select * from DATA WHERE ID = " & Me.Find_Field)
rs.MoveFirst
LoadData (True) ' Function that loads the data into the form
Exit Sub
As you all can see, I reload the recordset with a new filtered query. Up to this point it works, the problems begin when I try to modify a record.
Originally, when the form loads the recordset data, I am able to edit the data and the edited data would show in the table (which is what I want). But after I apply my filter, my code gives me the Run-Time error '3027': Cannot Update. Databse or object is read-only.
I am pretty much using the same code over and over to reload data from the table and it never gave me a problem until I 'overwrote' the source of the recordset. Any idea how can I resolve this issue? Thanks
I would prefer to use a standard Access bound form because it's simpler than what you appear to be doing.
I can change the form's RecordSource from the click event of my cmdApplyFilter button.
Private Sub cmdApplyFilter_Click()
Dim strSql As String
If Len(Me.txtFind_Field & vbNullString) > 0 Then
strSql = "SELECT * FROM tblFoo WHERE id = " & _
Me.txtFind_Field & " ORDER BY id;"
Me.RecordSource = strSql
End If
End Sub
If you're concerned someone might save the form with the filtered RecordSource, you can make the form always open with the unfiltered version.
Private Sub Form_Open(Cancel As Integer)
Dim strSql As String
strSql = "SELECT * FROM tblFoo ORDER BY id;"
Me.RecordSource = strSql
End Sub