Rx_
Nothing In Moderation
- Local time
- Today, 14:18
- Joined
- Oct 22, 2009
- Messages
- 2,803
Set rstMisc = CurrentDb.OpenRecordset ' tough time finding a clear solution
The 4 fields in a form (connected to one table) are a disconnected dataset.
The table in this case has one record for each CustomerID the primary key or it has NO records for the CustomerID.
If there is a customerID - then just edit the record.
If there is no record with the customerID, then create the first record.
Key: The CurrentDB.OpenRecordset must be changed to add a new record
Then changed back to the edit only mode.
Otherwise an Object Variable not Set error appears
In this example:
Check to determine if a record exist for the primary key:
If not - fill the text boxes with blank
if yes - fill the text boxes with values from the table
A function returns a T/F to determine if a Record exist for the CustomerID
If a record exist, edit the field
Note: the user is asked "do you want to save" each time an individual record is changed
If YES - then just update all the fields included the changed field
if NO - go back to the record and repopulate the fields (i.e. undo)
If there is no record, this is the first record to be added and the OpenRecordset must change to be able to use the AddNew
One final note: The debug.print statements - Access 2007 will error when attempting to "step through" the Edit or Addnew process.
So, use Debug.print to see the progress.
The 4 fields in a form (connected to one table) are a disconnected dataset.
The table in this case has one record for each CustomerID the primary key or it has NO records for the CustomerID.
If there is a customerID - then just edit the record.
If there is no record with the customerID, then create the first record.
Key: The CurrentDB.OpenRecordset must be changed to add a new record
Then changed back to the edit only mode.
Otherwise an Object Variable not Set error appears
In this example:
Check to determine if a record exist for the primary key:
If not - fill the text boxes with blank
if yes - fill the text boxes with values from the table
A function returns a T/F to determine if a Record exist for the CustomerID
If a record exist, edit the field
Note: the user is asked "do you want to save" each time an individual record is changed
If YES - then just update all the fields included the changed field
if NO - go back to the record and repopulate the fields (i.e. undo)
If there is no record, this is the first record to be added and the OpenRecordset must change to be able to use the AddNew
One final note: The debug.print statements - Access 2007 will error when attempting to "step through" the Edit or Addnew process.
So, use Debug.print to see the progress.
Code:
[FONT=Calibri]Option Compare Database[/FONT]
[FONT=Calibri]Option Explicit[/FONT]
[FONT=Calibri]Dim dbMisc As dao.Database, rstMisc As dao.Recordset ‘ Keep variables alive at form level[/FONT]
[FONT=Calibri]Dim blSpudRecordExist As Boolean ' flag - does record exist for disconnected recordset group (determins edit or append)[/FONT]
[FONT=Calibri]Dim txtSpudDateValue As String[/FONT]
[FONT=Calibri]Dim txtIPDateValue As String[/FONT]
[FONT=Calibri]Dim txtcmpletiondateValue As String[/FONT]
[FONT=Calibri]Dim ckbondReleaseValue As Integer[/FONT]
[FONT=Calibri]Dim ControlName_Current As String debug[/FONT]
[FONT=Calibri]Dim intID_Customer As Integer ' hold the me.ID_Customer value - as variable – primary key for form[/FONT]
[B][FONT=Calibri]‘ When form loads – create Recordset and populate text boxes[/FONT][/B]
[FONT=Calibri]Private Sub Form_Load() ‘' Create Disconnected Recordset that only responds to ID_Customer[/FONT]
[FONT=Calibri]Dim SQLMisc As String[/FONT]
[FONT=Calibri]On Error Resume Next[/FONT]
[FONT=Calibri]SQLMisc = "SELECT Customer_CompletionSpud.* FROM Customer_CompletionSpud " & _[/FONT]
[FONT=Calibri] "WHERE (((Customer_CompletionSpud.ID_Customer)=" & Me!ID_Customer & "));" ‘ ID_Customer primary customerkey[/FONT]
[FONT=Calibri]Set rstMisc = CurrentDb.OpenRecordset(SQLMisc, dbOpenDynaset) ‘ can edit but can’t append[/FONT]
[FONT=Calibri] If ((SpudGroup_Exist_For_Customers(Me.ID_Customer)) And (rstMisc.Fields("Activity").Value = "A")) Then[/FONT]
[FONT=Calibri] rstMisc.MoveFirst ' ID_Customer is a primary key – no duplicates[/FONT]
[FONT=Calibri] Me.txtSpudDate = rstMisc.Fields("dt_spud").Value ‘ Populate text boxes[/FONT]
[FONT=Calibri] Me.txtIPDate = rstMisc.Fields("Dt_IP").Value[/FONT]
[FONT=Calibri] Me.txtCompletionDate = rstMisc.Fields("Dt_compl_due").Value[/FONT]
[FONT=Calibri] Me.ckBondRelease = rstMisc.Fields("Bond_Release").Value[/FONT]
[FONT=Calibri] Else[/FONT]
[FONT=Calibri] Me.txtSpudDate = "" ‘ for primary key there may not be an associated record[/FONT]
[FONT=Calibri] Me.txtIPDate = ""[/FONT]
[FONT=Calibri] Me.txtCompletionDate = ""[/FONT]
[FONT=Calibri] Me.ckBondRelease = ""[/FONT]
[FONT=Calibri] End If[/FONT]
[FONT=Calibri]End Sub[/FONT]
[FONT=Calibri]Function SpudGroupingLogic_LostFocus(ControlName As String)[/FONT]
[FONT=Calibri] On Error GoTo error_Trap[/FONT]
[FONT=Calibri] ' Only bother user if something changed in the 3 data and 1 check box! [/FONT]
[FONT=Calibri] ‘ Business logic – if record exist – then edit, if no record exist create a new record[/FONT]
[FONT=Calibri] ‘ in this case – the user is asked if they want to save (yes, no) on the lost focus of each field (It was a business requirement in this case).[/FONT]
[FONT=Calibri] Dim FlagTextboxChanged As Boolean[/FONT]
[FONT=Calibri] Dim ValueChangedAnswer As Integer[/FONT]
[FONT=Calibri] Dim SQLMisc As String[/FONT]
[FONT=Calibri]10 FlagTextboxChanged = False ' false until proven true[/FONT]
[FONT=Calibri] ' The jury - if any changed, then set FlagTextboxChanged to true, otherwise leave false[/FONT]
[FONT=Calibri]20 If (txtSpudDateValue <> Me.txtSpudDate.Value) Then FlagTextboxChanged = True[/FONT]
[FONT=Calibri]30 If (txtIPDateValue <> Me.txtIPDate) Then FlagTextboxChanged = True[/FONT]
[FONT=Calibri]40 If (txtcmpletiondateValue <> Me.txtCompletionDate.Value) Then FlagTextboxChanged = True[/FONT]
[FONT=Calibri]50 If (ckbondReleaseValue <> Me.ckBondRelease.Value) Then FlagTextboxChanged = True[/FONT]
[FONT=Calibri] ‘ Just tabbing through – no changes – if any one text box changed – then: [/FONT]
[FONT=Calibri]60 If FlagTextboxChanged Then[/FONT]
[FONT=Calibri]70 Debug.Print " **** Change detected for control " & ControlName[/FONT]
[FONT=Calibri]80 ValueChangedAnswer = MsgBox("The value changed, Yes to save or No to Undo", vbYesNo, "Verify Change")[/FONT]
[FONT=Calibri]90 If ValueChangedAnswer = vbYes Then[/FONT]
[FONT=Calibri]100 If blSpudRecordExist Then ‘ did a record already exist for this primary key?[/FONT]
[FONT=Calibri] Debug.Print " Begin Edit Mode +++++++++++"[/FONT]
[FONT=Calibri]110 rstMisc.Edit ' already a record – just edit it (and all the others while you are at it)[/FONT]
[FONT=Calibri]120 Debug.Print " Activate Edit Mode +++++++++++ Begin"[/FONT]
[FONT=Calibri]130 rstMisc.Fields("dt_spud").Value = Me.txtSpudDate ‘ each text box written to field[/FONT]
[FONT=Calibri]140 rstMisc.Fields("Dt_IP").Value = Me.txtIPDate[/FONT]
[FONT=Calibri]150 rstMisc.Fields("Dt_compl_due").Value = Me.txtCompletionDate[/FONT]
[FONT=Calibri]160 rstMisc.Fields("Bond_Release").Value = Me.ckBondRelease[/FONT]
[FONT=Calibri]180 rstMisc.Update ‘ update the edits[/FONT]
[FONT=Calibri]190 Else[/FONT]
[FONT=Calibri]195 Set rstMisc = CurrentDb.OpenRecordset("Customer_CompletionSpud", , [B]dbAppendOnly[/B]) ' reset the recordset type[/FONT]
[FONT=Calibri]200 rstMisc.AddNew ‘ this will error if record set not changed to dbAppendOnly[/FONT]
[FONT=Calibri]210 Debug.Print " Addnew Mode &&&&&&&&&&&&&&&" & Err.Number[/FONT]
[FONT=Calibri]220 rstMisc.Fields("ID_Customer").Value = Forms!home_2!lst_id_Customer ' If other part of form is null the txtCustomers_Id is null[/FONT]
[FONT=Calibri]230 rstMisc.Fields("dt_spud").Value = Me.txtSpudDate[/FONT]
[FONT=Calibri]240 rstMisc.Fields("Dt_IP").Value = Me.txtIPDate[/FONT]
[FONT=Calibri]250 rstMisc.Fields("Dt_compl_due").Value = Me.txtCompletionDate[/FONT]
[FONT=Calibri]260 rstMisc.Fields("Bond_Release").Value = Me.ckBondRelease[/FONT]
[FONT=Calibri]270 rstMisc.Update ‘ Completed update[/FONT]
[FONT=Calibri]271 SQLMisc = "SELECT Customer_CompletionSpud.* FROM Customer_CompletionSpud " & _[/FONT]
[FONT=Calibri] "WHERE (((Customer_CompletionSpud.ID_Customer)=" & Me!ID_Customer & "));"[/FONT]
[FONT=Calibri] Set rstMisc = CurrentDb.OpenRecordset(SQLMisc, dbOpenDynaset) ' back to original edit mode[/FONT]
[FONT=Calibri] ‘ Important – reset back to original edit mode[/FONT]
[FONT=Calibri]280 End If[/FONT]
[FONT=Calibri]290 Else ‘ user chose NO (or add some error trap code to set back to orginal)[/FONT]
[FONT=Calibri]300 Me.txtSpudDate.Value = txtSpudDateValue[/FONT]
[FONT=Calibri]310 Me.txtIPDate = txtIPDateValue[/FONT]
[FONT=Calibri]320 Me.txtCompletionDate.Value = txtcmpletiondateValue[/FONT]
[FONT=Calibri]330 Me.ckBondRelease.Value = ckbondReleaseValue[/FONT]
[FONT=Calibri]340 End If[/FONT]
[FONT=Calibri]350 FlagTextboxChanged = False ' either updated or cancel completed - set flag back to false[/FONT]
[FONT=Calibri]360 Else[/FONT]
[FONT=Calibri]370 Debug.Print " XXXX No change detected for control " & ControlName[/FONT]
[FONT=Calibri]380 End If[/FONT]
[FONT=Calibri]error_Trap:[/FONT]
[FONT=Calibri] If Err.Number > 1 Then Debug.Print Err.Description & " err on edit"[/FONT]
[FONT=Calibri]End Function[/FONT]
[FONT=Calibri]‘ custom Function to determine if Record Exist – if exist then edit, if not exist then create a new record[/FONT]
[FONT=Calibri]Function SpudGroup_Exist_For_Customers(ID_Customers As Integer) As Boolean[/FONT]
[FONT=Calibri] Dim intSpudGroup_Records_For_Customers As Integer[/FONT]
[FONT=Calibri] Dim SpudGroup_Records As dao.Recordset[/FONT]
[FONT=Calibri] Dim strSQL As String[/FONT]
[FONT=Calibri]10 On Error GoTo PROC_ERROR[/FONT]
[FONT=Calibri]20 SpudGroup_Exist_For_Customers = False ' Assumes False until proven True[/FONT]
[FONT=Calibri]30 ' SpudGroup Sundries Spud - located in two tables - if a record exist in either one return True[/FONT]
[FONT=Calibri]476 strSQL = "SELECT Customer_CompletionSpud.ID_Customer FROM Customer_CompletionSpud WHERE (((Customer_CompletionSpud.ID_Customer)=" & ID_Customers & "));"[/FONT]
[FONT=Calibri]480 Set SpudGroup_Records = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset) ' found dynaset faster than snapshot[/FONT]
[FONT=Calibri] If SpudGroup_Records.RecordCount > 0 Then 'it is set to false - if record count is > 0 then it is true[/FONT]
[FONT=Calibri]490 SpudGroup_Records.MoveLast ' this errors if recordcount is zero only saves 10 seconds if commented out[/FONT]
[FONT=Calibri]500 If Not IsNull(SpudGroup_Records.RecordCount) Then[/FONT]
[FONT=Calibri]520 intSpudGroup_Records_For_Customers = SpudGroup_Records.RecordCount[/FONT]
[FONT=Calibri]540 Else[/FONT]
[FONT=Calibri]550 MsgBox "Problem with SpudGroup_Exist_For_Customers function", vbOKOnly, "Make a note"[/FONT]
[FONT=Calibri]560 Err.Raise 2323, "Function SpudGroup_Exist_For_Customers", "Record count returned null"[/FONT]
[FONT=Calibri]570 End If[/FONT]
[FONT=Calibri]600 If intSpudGroup_Records_For_Customers > 0 Then[/FONT]
[FONT=Calibri]610 SpudGroup_Exist_For_Customers = True[/FONT]
[FONT=Calibri]620 Else[/FONT]
[FONT=Calibri]630 SpudGroup_Exist_For_Customers = False[/FONT]
[FONT=Calibri]650 End If[/FONT]
[FONT=Calibri] End If[/FONT]
[FONT=Calibri]PROC_EXIT:[/FONT]
[FONT=Calibri]1390 On Error Resume Next[/FONT]
[FONT=Calibri] Set SpudGroup_Records = Nothing[/FONT]
[FONT=Calibri]1420 Exit Function[/FONT]
[FONT=Calibri]PROC_ERROR:[/FONT]
[FONT=Calibri]1430 Select Case Err.Number[/FONT]
[FONT=Calibri] 'Case ###[/FONT]
[FONT=Calibri] Case Else[/FONT]
[FONT=Calibri]1450 Resume PROC_EXIT[/FONT]
[FONT=Calibri]1460 End Select[/FONT]
[FONT=Calibri]End Function[/FONT]
