Me.Dirty moves currently selected record - sql

I have an Access 2007 form that's giving me some headache.
I have a list of records that start as a combo box to pick a company and then a series of checkboxes to indicate the company's role.
If the user needs to add a new company, they'd pick the company name from the combo box, and then click the checkbox that indicates what role the company is playing. When the checkbox is checked, the form follows the following code to show a popup that captures additional information:
Private Sub chkOperationsAndMaintenance_AfterUpdate()
'DoCmd.RunCommand acCmdSaveRecord'
If Me.Dirty Then Me.Dirty = False
If chkOperationsAndMaintenance.Value = True Then
DoCmd.OpenForm "OmPopupForm", , , "CompanyProjectId = " & Me.CompanyProjectID, , acDialog
Me.Requery
End If
End Sub
This code will save the record on the CompanyProject table to create the row. It then pulls the CompanyProjectID (PK of the CompanyProject table) so it knows which ID to feed the popup.
The issue I'm having is that on the Me.Dirty line (and also the above commented-out acCmdSaveRecord), the entire form saves and refreshes, moving the selected row to the first record (in this case, "Gamesa") rather than the newly entered record. So the ensuing popup is fed the CompanyProjectID of the first record rather than the newly-entered record, and it also reads the "checked" state of the checkbox from the first record rather than the one upon which the user is working.
I doctored the code to look like this:
Private Sub chkOperationsAndMaintenance_AfterUpdate()
Dim CPID As Long
Dim CID As Long
Dim rs As Recordset
Set rs = Me.RecordsetClone
CID = Me.CompanyID
'DoCmd.RunCommand acCmdSaveRecord'
If Me.Dirty Then Me.Dirty = False
CPID = DLookup("MAX(CompanyProjectID)", "CompanyProject", "cpProjectID = " & Me.cpProjectID & _
" AND CompanyID = " & CID)
rs.Find "[CompanyProjectID] = " & CPID
Me.Bookmark = rs.Bookmark
If chkOperationsAndMaintenance.Value = True Then
DoCmd.OpenForm "OmPopupForm", , , "CompanyProjectId = " & Me.CompanyProjectID, , acDialog
Me.Requery
End If
End Sub
The idea with these alterations is that we'll get the FK from the parent form ("cpProjectID") and the CompanyID of the selection from the combobox, then save the record. Once the record is saved, we have the CompanyProjectID already stored, so then the rs.Find and Me.Bookmark lines will then select the record that matches that CompanyProjectID.
This sometimes works, and sometimes doesn't. Generally doesn't. In this case, I refreshed the parent form and the current form and attempted to add a new company and then click the "Owner" checkbox (which uses the same code as above, just a different checkbox ID) to see the Bookmark on the wrong row:
At this point, I'm not sure what to do. If I don't save the record (via acCmdSaveRecord or Me.Dirty=False) then I don't have a CompanyProjectID to send as the input parameter for the ensuing popup, but if I do save the record, then the form changes the record and the wrong parameter is sent and the wrong checkbox's checked state is read. I can't just use an arbitrary index to work off of (such as acNewRec), as the user might need to edit an existing row instead of adding a new one.
I tried the method in this post already: MS Access how to Update current row, move to next record, not first, but the find/bookmark isn't consistently working.
EDIT (12/15/2014)
I ended up going with the following VBA code:
Private Sub chkOperationsAndMaintenance_AfterUpdate()
Dim CPID As Long
Dim CID As Long
Dim rs As Recordset
Set rs = Me.RecordsetClone
CID = Me.CompanyID
If Me.Dirty Then Me.Dirty = False
CPID = DLookup("MAX(CompanyProjectID)", "CompanyProject", "cpProjectID = " & Me.cpProjectID & _
" AND CompanyID = " & CID)
Do While Me.CompanyProjectID <> CPID
If Me.CurrentRecord < Me.Recordset.RecordCount Then
DoCmd.GoToRecord , , acNext
Else
DoCmd.GoToRecord , , acFirst
End If
Loop
If chkOperationsAndMaintenance.Value = True Then
DoCmd.OpenForm "OmPopupForm", , , "CompanyProjectId = " & Me.CompanyProjectID, , acDialog
Me.Requery
End If
End Sub
I feel like there has to be a better answer for this, but this is appearing to work right now. I have my end user/lab rat testing it at the moment, so I'll mark this complete if this pans out. I still think there has to be a better solution for this, but at the moment, this solution is able to capture the requisite ID to pass to the popup, and it selects the appropriate row after this ID is captured.

Have you considered saving the current position - like Me.CurrentRecord, then after the save reposition to the desired record. As an example, you could add a 'Before' or 'After' Insert to save the position, then later reposition. See the following:
Option Compare Database
Option Explicit
Dim lCurRec As Long
Private Sub Form_AfterInsert()
lCurRec = Me.CurrentRecord
Debug.Print "After Insert, Current: " & Me.CurrentRecord
End Sub
<<< YOUR SUB>>>
DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, lCurRec

This code will work when adding a new record as well as when editing an existing record:
Private Sub chkOperationsAndMaintenance_AfterUpdate()
Dim c As Long
Me.Dirty = False
If chkOperationsAndMaintenance Then
DoCmd.OpenForm "OmPopupForm", , , "CompanyProjectId = " & Me.CompanyProjectID, , acDialog
c = Me.CurrentRecord
Me.Requery
DoCmd.GoToRecord , , acGoTo, c
End If
End Sub
I am guessing that your popup form does things that are specific to Operations & Maintenance, and does not change the values of any of the checkboxes on the main form. If this is the case, you don't need a Requery at all, and the code can be simplified:
Private Sub chkOperationsAndMaintenance_AfterUpdate()
Me.Dirty = False
If chkOperationsAndMaintenance Then
DoCmd.OpenForm "OmPopupForm", , , "CompanyProjectId = " & Me.CompanyProjectID, , acDialog
End If
End Sub

Related

prevent duplicates when passing values between two forms (with Args)

I have two forms: transfert Form with its subform and intransfert Form. I am using
DoCmd.OpenForm "intransfert", , , , acFormAdd, acDialog, Me!Text83
(where text83 is =[transfertasubform].[Form]![transfertadetailid] under
Private Sub Command78_Click()
in transfet form and
Private Sub Form_Load()
On Error Resume Next
If Me.NewRecord Then Me!trnrin = Me.OpenArgs
in intransfet form. intransfert form is based in transfertdetailquery. i wont to prevent passing text83 value more then one time
i tried to explain my problem and expect a help to prevent duplicates when used Arge
assuming trnrin is the name of a variable in your record source. assuming you mean that you want to avoid adding two records where trnrin has the same value and the user sent the same open args twice. assuming trnrin is also the name of a control in the detail section of the intransfert form.
'form load only runs when the form is opened so you have to close the form to pass new args
'but you can just move the same code to a button or whatever
Private Sub IntransferForm_Load()
If Len(Me.OpenArgs) > 0 Then
Me.txtBoxintheHeader = Me.OpenArgs 'the load event is the right place to set controls
'most of this code is to check if there is already an instance where trnrin = the OpenArgs in the record source
Dim lookedupArgs As String
lookedupArgs = Nz(lookedupArgs = DLookup("trnrin", "MyTable", "trnrin = " & "'" & Me.OpenArgs & "'"), "ValuethatisneveranArg")
If lookedupArgs = "ValuethatisneveranArg" Then
'Debug.Print "trnrin = '" & Me.OpenArgs & "'" 'note the string delimiters
'Me.trnrin = Me.OpenArgs 'this surprisingly works but will break easily and doesn't handle complex cases
Dim rs As Recordset
Set rs = Me.Recordset 'if recordset is bound to a table then table will also be updated.
'you can also bind to the table directly but you may need to call me.requery to show the changes
rs.AddNew
rs!trnrin = Me.OpenArgs
rs.Update
End If
End If
End Sub

Close subform, remove main form filter and go back to original record

I am opening a subform from my main form to allow data to be changed. Once the changes are made, I want to pass the data back to the main form. remove the filter, and go back to the original record. I have the Primary Key in the subform so I am passing it back. I used some code from another user's but it did not work not is my code. Any thoughts?
Private Sub cmd_close_Click()
Dim result As String
Dim ID As Variant
result = MsgBox("Save Geo Location?", vbOKCancel, "Save Geo Location")
If result = vbOK Then
Forms!frm_acct_select!GeoLoc_X = Me.txt_GeoLocX
Forms!frm_acct_select!GeoLoc_Y = Me.txt_GeoLocY
Forms!frm_acct_select.FilterOn = False
'this code fails immediately
With frm_acct_select.Form
ID = Me.txt_ParentID.Value
.FilterOn = False
.Recordset.FindFirst "ParentAccountID=" & ID
End With
'this code fails type mismatch criteria at the recordset.findfirst line
' With Forms!frm_acct_select
' ID = Me.txt_ParentID.Value
' .FilterOn = False
' .Recordset.FindFirst "ParentAccountID = " & ID
' End With
DoCmd.Close acForm, "sfrm_geoloc_update", acSaveNo
Else
DoCmd.Close acForm, "sfrm_acct_select_search", acSaveNo
End If
End Sub
Apparently, I still need to work on my string formatting.
Declaring ID as String was correct however I needed to add quotes to my code.
.Recordset.FindFirst "ParentAccountID = '" & ID & "'"

Subform blocking Recordset.AddNew (Error 3027)

Having a subform displaying the same table used in recordset makes the table read only (error 3027). Getting rid of the subform fixes the problem. Similar setup works in my other form interface.
I tried to delete the subform, which fix the accessibility problem. But that would defeat the original UX purpose.
Option Explicit
Public UnitRS As DAO.Recordset
Public ModelRS As DAO.Recordset
Public NameUnitRecords As String
Public NameModelRecords As String
Public Sub Form_Load()
'Initialization
NameUnitRecords = "tblBatteriesMainRecordsUnits"
NameModelRecords = "tblBatteriesRecordsModels"
End Sub
Private Sub SetUnitRecordsets()
'Set the path to the Battery Records table
Set UnitRS = CurrentDb.OpenRecordset(NameUnitRecords, dbOpenDynaset)
End Sub
Private Sub txtBatteryID_AfterUpdate()
'Set the recordset path for unit records
Call SetUnitRecordsets
'do a findfirst search for the Battery ID, using value from textbox txtBatteryID
UnitRS.FindFirst "[Battery ID]=" & txtBatteryID
'If no matching record, leave the other fields empty
If UnitRS.NoMatch Then
'If there is a matching record, then, grab the model number
Else
'as there is an existing record with model number, run a search on the model number and grab the model info
End If
'close recordset
UnitRS.Close
'check if the button can be enabled
End Sub
Private Sub cmbModelNumber_AfterUpdate()
'Set the recordset path for model records
'do a findfirst search for the Model Number, using value from combobox cmbModelNumber
'If no matching record, leave the other fields empty
If ModelRS.NoMatch Then
'If there is a matching record, then, grab the Model Info
Else
End If
'close recordset
'check if the button can be enabled
End Sub
Private Sub btnSaveAndCLear_Click()
Dim Response, strOldModelNumber
'Set the recordset path for unit records
Call SetUnitRecordsets
'Set the recordset path for model records
'close all related tables, queries and forms
DoCmd.Close acTable, NameUnitRecords, acSaveYes
DoCmd.Close acForm, "frmSubBatteriesMainRecordsUnits", acSaveYes
'If a new model record is required
ModelRS.FindFirst "[Model Number]='" & cmbModelNumber & "'"
If ModelRS.NoMatch Then
'msg box confirm model information
'If user chooses yes
If Response = vbYes Then
'create new model record
'this block could be done with "With...End" format for less error vulerability?
'nah, unless it is repetitively called, it's too much work to inplement just the .addnew part
'requery the two combobox to reflect newest changes
'User chooses no
Else
'popup a message telling the user the battery and model record is not logged, but don't clear the field.
Exit Sub
End If
End If
'need to find the record first, otherwise it will edit the first one
UnitRS.FindFirst "[Battery ID]=" & txtBatteryID
'store the old model number value
strOldModelNumber = UnitRS("Model Number")
'New record
If UnitRS.NoMatch Then
'create a new battery record
UnitRS.AddNew
UnitRS("Battery ID") = Me.txtBatteryID
'If this is an edit on existing record
Else
'if the new value is the same as the old one
If strOldModelNumber = cmbModelNumber Then
'msgbox the same value, no change is done to the database
MsgBox "the data is the same as the old record, no change is made to the record", vbInformation, "Same data"
Exit Sub
Else
'msg box confirm edit
Response = MsgBox("Please confirm edit on existing record: " & Chr(13) & Chr(10) & "BatteryID: " & txtBatteryID & Chr(13) & Chr(10) & "Model Number: " & cmbModelNumber, vbYesNo, "New Model Record Dectected")
'If user chooses yes
If Response = vbYes Then
'goto edit mode
UnitRS.Edit
'if user chooses no
Else
'msgbox notify the user nothing is changed in the database
MsgBox "Battery and Model record not logged, you may retry logging", vbInformation, "Record not logged"
Exit Sub
End If
End If
End If
'both changes the model number and comment field anyway
UnitRS("Model Number") = Me.cmbModelNumber
UnitRS("Comment") = Me.txtComment
'commit update
UnitRS.Update
UnitRS.Close
'clear all flieds
'reset all locks
'requery the sub form to reflect the newest changes
Me.subFrmBatteryRecords.Requery
End Sub
What I would like to achieve is to have a display in the form interface to show the content of the actual record table, so that the user knows what is in the table.
There is nothing wrong with my code. There is a property option in the form object, it's called "record lock", somehow mine had "All Records" selected. By making it "No locks", the accessibility problem is gone.

Filtering data on form causes combo box to not function

I have a form that displays student records.
I have a combobox that allows you to select a student.
Finally, I have two buttons for filtering. One filters on all Students the other only active Students.
Two Issues which I beleive are related.
One, when the form loads the cbo does NOT work.
Two, if I select the "All Students" button the cbo works. When I select the "Active Students" button the cbo does NOT work again.
Form Record Source:
Select tblStudents.*
Form Load:
Private Sub cmdStudent_Click()
On Error GoTo cmdStudent_Click_Err
DoCmd.OpenForm "frmStudents", acNormal, "", "[Last3]=" & "'" & "Sanders
862" & "'", , acNormal
cmdStudent_Click_Exit:
Exit Sub
cmdStudent_Click_Err:
MsgBox Error$
Resume cmdStudent_Click_Exit
End Sub
ComboBox Code:
Private Sub cboFindRecord_AfterUpdate()
' Find the record that matches the control.
Dim rs As Recordset
Set rs = Me.RecordsetClone
rs.FindFirst "[SN] = '" & Me![cboFindRecord] & "'"
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub
All Students Button:
Private Sub cmdAllStudents_Click()
cmdAllStudents.ForeColor = 16777215
cmdAllStudents.BackColor = 16711680
cmdAllStudents.FontBold = True
cmdActiveStudents.ForeColor = 0
cmdActiveStudents.BackColor = 16777215
cmdActiveStudents.FontBold = False
Me.FilterOn = False
cboFindRecord.RowSourceType = "Table/Query"
cboFindRecord.RowSource = "SELECT tblStudents.SN, tblStudents.Last3 FROM
tblStudents ORDER BY tblStudents.Last3;"
cboFindRecord.Requery
Call cboFindRecord_AfterUpdate
cboFindRecord.SetFocus
End Sub
Active Student Button:
Private Sub cmdActiveStudents_Click()
cmdActiveStudents.ForeColor = 16777215
cmdActiveStudents.BackColor = 16711680
cmdActiveStudents.FontBold = True
cmdAllStudents.ForeColor = 0
cmdAllStudents.BackColor = 16777215
cmdAllStudents.FontBold = False
Me.FilterOn = True
cboFindRecord.RowSourceType = "Table/Query"
cboFindRecord.RowSource = "SELECT tblStudents.SN, tblStudents.Last3,
tblStudents.Status_ID FROM tblStudents WHERE (((tblStudents.Status_ID) Not
In (6,7))) ORDER BY tblStudents.Last3;"
cboFindRecord.Requery
Call cboFindRecord_AfterUpdate
cboFindRecord.SetFocus
End Sub
Thank you for any assistance.
I have tried modifying the record set to match all or active students with no change.
OK, not sure why this is happening but I have fixed my issue. The problem is with the form loading code.
When I was loading the Student from from another form, I had it load our test student by default. My theory is that this was changing the record-set. I would appreciate an explanation if someone knows.
I removed forcing the student record when loading the student form and put the code in the On Load event for the form.

Updating a record by using a selection box control

I would like to know what the preferred function to put in a code string immediately after a user selects a selection box control of a record so that his selection is acknowleged and included as "true". In short, I have a form where the user uses a selection box to indicate which records to select and then executes a command where I have code that should copy and paste the records he selected. Unfortunately, the last record selected, upon running executing the copy/paste command is not recognised. I understand that I probably need to add a function such as ' go-to the next record' however I am not sure if this is the best way or if there is a more standard way that programmers use to not lose the last record selected. Below is the code I am currently using which currently does not pick up the last record selected by the user.
Private Sub Comando99_Click()
If CurrentRecord = Recordset.RecordCount And CurrentRecord <> 1 Then
DoCmd.GoToRecord , "", acFirst
Else
DoCmd.GoToRecord , "", acNext
End If
Dim intAnswer As Integer
On Error GoTo HandleError
intAnswer = _
MsgBox("Are you sure you want to add these dependencies to your dependency project tracker?", _
vbQuestion + vbYesNo, "Add Dependencies")
If intAnswer = vbYes Then
st_sql = "INSERT INTO [tblDependencies] ( [Description] )SELECT [tblDependencyTypeListing].[Dependency (General)] FROM [tblDependencyTypeListing] WHERE ((([tblDependencyTypeListing].[ToIncludeInProject])=True))"
Application.DoCmd.RunSQL (st_sql)
st_sql = "UPDATE[tblDependencies],[tblHoldingProjectid]SET[tblDependencies].[ID Project]=[tblholdingprojectid].[ID_Project]where([tbldependencies].[ID Project])=0 and ([tblholdingprojectid].[ID_Project])is not null"
Application.DoCmd.RunSQL (st_sql)
st_sql = "UPDATE[tblDependencies]SET[tblDependencies].[Automatic date of entry]=now() where([tblDependencies].[Automatic date of entry])is null"
Application.DoCmd.RunSQL (st_sql)
st_sql = "UPDATE[tblContacts],[tblDependencies]SET[tblDependencies].[Automatic user entry]=[tblContacts].[Complete name]where([tblContacts].[In use])is not null and([tblDependencies].[Automatic user entry])is null"
Application.DoCmd.RunSQL (st_sql)
st_sql = "UPDATE[tblDependencytypelisting]SET[tblDependencytypelisting].[toincludeinproject]=null"
Application.DoCmd.RunSQL (st_sql)
Me.Refresh
End If
ExitHere:
Exit Sub
HandleError:
MsgBox "Error is " & Err.Description
Resume ExitHere
End Sub
Problem is resolved by entering the following IF statement at the beginning of the routine to ensure that prior to running the code, ACCESS moves to the next record to ensure that it acknowledges the last modification made
If CurrentRecord = Recordset.RecordCount And CurrentRecord <> 1 Then
DoCmd.GoToRecord , "", acFirst
Else
DoCmd.GoToRecord , "", acNext
End If