I am new to programming in VBA. I am trying to copy Form data from an existing form when I click on the Copy Record button. This is supposed to copy the current form data as a new record with a new master_id (that is autonumbered) and have Brand as blank field for them to fill in. I get a:
Run Time Error 3265 "Item not found in this collection"
at the new_master_id that i created. I am not sure how to fix this problem. Any help is appreciated.
Private Sub Copy_Record_Click()
Dim RS As DAO.Recordset, C As Control
Dim FillFields As String, FillAllFields As Integer
Dim New_MASTER_ID As Integer
New_MASTER_ID = (DMax("[MASTER_ID]", "tbl_Drug_Master") + 1)
Dim BRAND As String
BRAND = ""
Set RS = CurrentDb.OpenRecordset(Name:="tbl_Drug_Master", Type:=RecordsetTypeEnum.dbOpenDynaset)
With RS
.AddNew
![MASTER_ID] = ![New_MASTER_ID] <--this is where the problem is...
![MASTER_KEY] = Me![MASTER_KEY]
![PRODUCT_CATEGORY] = Me![PRODUCT_CATEGORY]
![BRAND] = Me![BRAND]
![GENERIC] = Me![GENERIC]
![STUDY_NAME] = Me![STUDY_NAME]
![MANUFACTURER] = Me![MANUFACTURER]
![MASTER_COMMENTS] = Me![MASTER_COMMENTS]
.Update
End With
End Sub
ok so firstly, im not sure why the following are required:
dim c as control
Dim FillFields As String, FillAllFields As Integer
New_MASTER_ID = (DMax("[MASTER_ID]", "tbl_Drug_Master") + 1)
Dim BRAND As String
BRAND = ""
therefore I am leaving them out as part of this question because they appear unnecessary. Brand is not required because you are creating a new record and putting nothing in the brand field so it will remain blank.
I am also not too sure why you have 2 tables both that are the same? I think what should happen is that you simply copy the data to a new record in the same table.
You will see I have put a save record command in to the routine. other additions such as error handling is also recommended.
Private Sub Copy_Record_Click()
docmd.runcommand accmdsaverecord
Dim RS As Recordset
Set RS = CurrentDb.OpenRecordset(Name:="tbl_Drug_Master", Type:=RecordsetTypeEnum.dbOpenDynaset)
With RS
.AddNew
![MASTER_KEY] = Me.MASTER_KEY.value
![PRODUCT_CATEGORY] = Me.PRODUCT_CATEGORY.value
![GENERIC] = Me.GENERIC.value
![STUDY_NAME] = Me.STUDY_NAME.value
![MANUFACTURER] = Me.MANUFACTURER.value
![MASTER_COMMENTS] = Me.MASTER_COMMENTS.value
.Update
End With
Set RS = Nothing
End Sub
I was mistaken with my comment rs.close it would be db.close but you are using the currentdb and no reason to close it. This procedure will remain on the original record, if you want to go to the new record you will have to add a command like docmd.gotorecord acdataform, , aclast before the end of the routine.
Related
I am trying to write some code to audit changes made via a form. I have a function that works to do this:
Function WriteChanges()
Dim f As Form
Dim c As Control
Dim user As String
Dim db As DAO.Database
Dim cnn As ADODB.Connection
Dim MySet As ADODB.Recordset
Dim tbld As TableDef
Dim recsource As String
Set f = Screen.ActiveForm
Set db = CurrentDb
Set cnn = CurrentProject.Connection
Set MySet = New ADODB.Recordset
recsource = f.RecordSource
Set tbld = db.TableDefs(recsource)
pri_key = fFindPrimaryKeyFields(tbld)
Debug.Print "pri_key: "; pri_key
user = Environ("username")
MySet.Open "Audit", cnn, adOpenDynamic, adLockOptimistic, adCmdTable
For Each c In f.Controls
Select Case c.ControlType
Case acTextBox, acComboBox, acListBox, acOptionGroup
If c.Value <> c.OldValue Then
With MySet
.AddNew
![EditDate] = Now
![user] = user
![SourceTable] = f.RecordSource
![SourceField] = c.ControlSource
![BeforeValue] = c.OldValue
![AfterValue] = c.Value
.update
End With
End If
End Select
Next c
MySet.Close
Set MySet = Nothing
Set f = Nothing
Set db = Nothing
End Function
I use this function on the before update property of various forms and it populates the Audit table with the details of the changes to values in each of the controls. I need to also get the value from the primary key field to add to the Audit table. I can use the following code to identify the name of the primary key within the form's record source:
Function fFindPrimaryKeyFields(tdf As TableDef) As String
Dim idx As Index
On Error GoTo HandleIt
For Each idx In tdf.Indexes
If idx.Primary Then
fFindPrimaryKeyFields = Replace(idx.Fields, "+", "")
GoTo OutHere
End If
Next idx
OutHere:
Set idx = Nothing
Exit Function
HandleIt:
Select Case Err
Case 0
Resume Next
Case Else
Beep
MsgBox Err & " " & Err.Description, vbCritical + vbOKOnly, "Error"
fFindPrimaryKeyFields = vbNullString
Resume OutHere
End Select
End Function
How can I use this to get the value from the control (text box) that has the identified primary key as its control source.
Please forgive any silly errors in my code as I'm a relative novice. Thanks in advance for any help.
I'm not 100% sure what you want exactly, but if you have the name of the field, you can use the following:
Dim primaryKeyValue As Variant
Dim primaryKeyColumnName As String
primaryKeyColumnName = fFindPrimaryKeyFields(TableDefs!MyTable)
Dim f as Form
'Get the form somehow
Dim c As Control
On Error GoTo NextC 'Escape errors because lots of controls don't have a control source
For Each c In f.Controls
If c.ControlSource = primaryKeyColumnName Then
primaryKeyValue = c.Value
End If
NextC:
Next c
On Error GoTo 0
If the primary key column is part of the form record source, you can simply read it by:
Debug.Print "PK value: " & f(pri_key)
Every column of the record source is a form property at runtime, independent of whether there is a control with the same name.
Note: your whole construct will stop working if you have a form that is based on a query that joins multiple tables.
I have a saved query, qryInsertLog which is as follows:
PARAMETERS UserIDPar Long, UnitIDPar Long, LogEntryPar LongText, FNotesPar LongText;
INSERT INTO tblLogBook ( UserID, UnitID, LogEntry, FNotes )
SELECT [UserIDPar] AS Expr1, [UnitIDPar] AS Expr2, [LogEntryPar] AS Expr3, [FNotesPar] AS Expr4;
I'm trying to run this query when a save button is clicked on an unbound form, where the parameters are gathered from the form controls. My VBA code for the save button is:
Private Sub cmdSave_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim okToSave As Boolean
If Me.cboUser.Value = 0 Or IsNull(Me.cboUser.Value) Then
MsgBox "You must choose a user. Record not saved."
okToSave = False
ElseIf Me.cboUnit.Value = 0 Or IsNull(Me.cboUnit.Value) Then
MsgBox "You must choose a unit. Record not saved."
okToSave = False
ElseIf Me.txtLogEntry.Value = "" Or IsNull(Me.txtLogEntry.Value) Then
MsgBox "You must have somtehing to log. Record not saved."
okToSave = False
Else
okToSave = True
End If
Set db = CurrentDb
Set qdf = db.QueryDefs("qryInsertLog")
qdf.Parameters("UserIDPar").Value = Me.cboUser.Value
qdf.Parameters("UnitIDPar").Value = Me.cboUnit.Value
qdf.Parameters("LogEntryPar").Value = Me.txtLogEntry.Value
qdf.Parameters("FNotesPar").Value = IIf(IsNull(Me.txtFNotes.Value), "", Me.txtFNotes.Value)
If okToSave Then
qdf.Execute
End If
qdf.Close
Set qdf = Nothing
End Sub
When this code is run, the FNotes field of the table isn't updated. The other three fields update as expected. FNotes is the only field which isn't required. I hardcoded a string for FNotes paramater like so:
qdf.Parameters("FNotesPar").Value = "why doesn't this work"
rather than using the form control value, and got the same result: that field just doesn't update. When I run this query from the Access Objects window and supply parameter values from the prompts, it works just fine. When I create form that's bound to the table, it also seems to work just fine.
I can't figure out why there's no trouble updating the LogEntry field but the FNotes field fails to update.
Add the new record via a DAO.Recordset instead of a DAO.QueryDef.
First, include this declaration ...
Dim rs As DAO.Recordset
Then use this after Set db = CurrentDb ....
Set rs = db.OpenRecordset("tblLogBook")
With rs
If okToSave Then
.AddNew
!UserID = Me.cboUser.Value
!UnitID = Me.cboUnit.Value
!LogEntry = Me.txtLogEntry.Value
!FNotes = Nz(Me.txtFNotes.Value, "")
.Update
End If
.Close
End With
Note Nz(Me.txtFNotes.Value, "") gives you the same thing as IIf(IsNull(Me.txtFNotes.Value), "", Me.txtFNotes.Value), but more concisely.
thanks for all the communal help thus far! Referencing this site is a beautiful thing.
I've designed a front-end in Access and am having trouble getting my VBA code to work... would very much appreciate any feedback or suggestions! I'm still pretty new to VB and could very well be missing some basic components for this use-case....
Essentially my db is made up of 8 tables and then the relationship tables that join them. I want to build in the functionality that allows users to "attach" or relate entities in one table to others from a form.
Option buttons point to the different entity tables and set the record source for the combo box to choose any given record.
THE PROBLEM: my issue is trying to CREATE NEW record using all the info that users provide/choose(w/the comboboxes)
The Debugger has identified this line to be an issue:
Set rs = db.OpenRecordset(BUS_APP_SERVER_REL)
.. but my full code is below:
Private Sub Check259_Click()
Dim BP4_BizApp As String
BP4_BizApp = "SELECT [BUS_APPL_NAME],[BUS_APPL_ID] FROM [BUSINESS_APPLICATIONS] ORDER BY [BUS_APPL_NAME]"
If Me.Check259 = True Then
Me.Combo257.RowSource = BP4_BizApp
End If
End Sub
Private Sub Check261_Click()
Dim BP4_ITApp As String
BP4_ITApp = "SELECT [IT_APPL_NAME],[IT_APPL_ID] FROM [IT_APPLICATIONS] ORDER BY [IT_APPL_NAME]"
If Me.Check261 = -1 Then
Me.Combo257.RowSource = BP4_ITApp
End If
End Sub
Private Sub Check263_Click()
Dim BP4_Tool As String
BP4_Tool = "SELECT [TOOL_NAME],[TOOL_ID] FROM [TOOLS] ORDER BY [TOOL_NAME]"
If Me.Check263 = -1 Then
Me.Combo257.RowSource = BP4_Tool
End If
End Sub
Private Sub Check_265_Click()
Dim BP4_DB As String
BP4_DB = "SELECT [DB_NAME],[DB_ID] FROM [Databases] ORDER BY [DB_NAME]"
If Me.Check265 = -1 Then
Me.Combo257.RowSource = BP4_DB
End If
End Sub
Private Sub Command221_Click()
Dim db As Database
Dim rs As DAO.Recordset
Dim SVR_ID As Variant
Dim BizApp_ID As Variant
Dim ENV As Variant
Dim COMM As String
BizApp_ID = Me.Combo257.AfterUpdate
SVR_ID = Me!SERVER_ID
ENV = Me.Combo214.AfterUpdate
COMM = Me!Text216
Set dbVideoCollection = CurrentDb
Set rs = db.OpenRecordset(BUS_APP_SERVER_REL)
rs.AddNew
rs(BUS_APPL_ID).Value = BizApp_ID
rs("SERVER_ID").Value = SVR_ID
rs("ENV_TYPE").Value = ENV
rs("COMMENTS").Value = COMM
rs.Update
End Sub
Thank you for your time!
Ryan
There's a couple things here. Let's look at this sub:
Private Sub Command221_Click()
Dim db As Database
Dim rs As DAO.Recordset
Dim SVR_ID As Variant
Dim BizApp_ID As Variant
Dim ENV As Variant
Dim COMM As String
BizApp_ID = Me.Combo257.AfterUpdate
SVR_ID = Me!SERVER_ID
ENV = Me.Combo214.AfterUpdate
COMM = Me!Text216
Set dbVideoCollection = CurrentDb
Set rs = db.OpenRecordset(BUS_APP_SERVER_REL)
rs.AddNew
rs(BUS_APPL_ID).Value = BizApp_ID
rs("SERVER_ID").Value = SVR_ID
rs("ENV_TYPE").Value = ENV
rs("COMMENTS").Value = COMM
rs.Update
End Sub
First of all, you're Dimming db as Database. Then you're setting dbVideoCollection = CurrentDb. Then you're using db.OpenRecordset. I think you want to change "dbVideoCollection" to just "db".
Then, as HansUp noticed, you've got BUS_APP_SERVER_REL. If that's a table name or a query name, it's got to be in quotes.
Set rs = db.OpenRecordset("BUS_APP_SERVER_REL")
If it's a variable name, it's got to be wrapped in quotes (I believe):
Set rs = db.OpenRecordset("" & BUS_APP_SERVER_REL & "")
Some more things...
1) I suggest to add Option Explicit to the top of your module, it enforces variable declaration and reports undeclared variables/constants already at compile time.
This would have prevented the db vs. dbVideoCollection mix-up.
To have this automatically in new modules, set the Require Variable Declaration option in the VBA Editor.
2) Please don't use the default control names like Check263 or Command221, especially when they will be used in the code (but you should make it a general habit). Use meaningful names that you will recognize.
Some months from now you will look at your code, scratching your head "what was this line supposed to do... wait, which one was Check261 again?".
3) BizApp_ID = Me.Combo257.AfterUpdate makes no sense, you probably want simply
BizApp_ID = Me.Combo257.Value.
I have a userform that when a user clicks a button, it opens a new Comment log form. In this new form, I pull all the associated comments and display them in a subform/datasheet.
In this second form, I have a comment field to allow for the entry of a new comment. When the user clicks the add button, they can enter text then click the save button, and the comment saves to the associated table
(I am preventing Edits and deletions on this second form...only additions allowed)
Everything seems fine and it works well, however, when I go to the table I'm appending to, there are two appended records for a single comment. In both records, the comment text is present but in the first record, all other data elements are missing. The second record is perfect.
Any ideas where I'm going wrong?
Private Sub AddNew_Click()
Me.Item_ID = Forms![F_First_Form]![ID]
Me.Item_Number = Forms![F_First_Form]![Item Number]
Me.Form_Name = "F_First_Form"
Me.User_ID = (Environ$("Username"))
Me.Comment.SetFocus
End Sub
Private Sub Form_Load()
Me.Item_ID = Forms![F_First_Form]![ID]
Me.Item_Number = Forms![F_First_Form]![Item Number]
Me.Form_Name = "F_First_Form"
Me.User_ID = (Environ$("Username"))
Me.AddNew.SetFocus
End Sub
Private Sub SaveComment_Click()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb()
Set rst = dbs.TableDefs("Conversation_Log").OpenRecordset
If Me.Comment = vbNullString Or Me.Dirty = False Then
Exit Sub
Else
With rst
.AddNew
!Form_Name = "F_First_Form"
!User_ID = (Environ$("Username"))
!Item_Number = Me.Item_Number
!Item_ID = Me.Item_ID
!Comment = Me.Comment
.Update
End With
Me.Requery
Me.Refresh
MsgBox "Your comment has been saved"
End If
End Sub
Try commenting out the AddNew in the Form Load routine:
Private Sub Form_Load()
Me.Item_ID = Forms![F_First_Form]![ID]
Me.Item_Number = Forms![F_First_Form]![Item Number]
Me.Form_Name = "F_First_Form"
Me.User_ID = (Environ$("Username"))
**'Me.AddNew.SetFocus**
End Sub
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?