Code: Private Sub Combo19_NotInList(NewData As String, Response As Integer) Dim Db As DAO.Database Dim Rs As DAO.Recordset Dim Msg As String Dim NewID As String On Error GoTo Err_combo19_NotInList ' Exit this subroutine if the combo box was cleared. If NewData = "" Then Exit Sub ' Confirm that the user wants to add the new customer. Msg = "'" & NewData & "' is not in the list." & vbCr & vbCr Msg = Msg & "Do you want to add it?" If MsgBox(Msg, vbQuestion + vbYesNo) = vbNo Then ' If the user chose not to add a customer, set the Response ' argument to suppress an error message and undo changes. Response = acDataErrContinue ' Display a customized message. MsgBox "Please try again." Else ' If the user chose to add a new customer, open a recordset ' using the table. Set Db = CurrentDb Set Rs = Db.OpenRecordset("Patients", dbOpenDynaset) ' Create a new record. Rs.AddNew ' Save the record. Rs.Update ' Set Response argument to indicate that new data is being added. Response = acDataErrAdded End If Exit_combo19_NotInList: Exit Sub Err_combo19_NotInList: ' An unexpected error occurred, display the normal error message. MsgBox Err.Description ' Set the Response argument to suppress an error message and undo ' changes. Response = acDataErrContinue End SubAs you can see in the picture, the code half works.
Code: StrComp(str1, str2, vbTextCompare)but it also did not work. Both text may have Unicode non standard characters, though. When I used vbBinaryCompary, I got error "No current record". I spent the whole week to make it work but I am running out of ideas how to test the procedure and get rid of faulty pieces of codes.
Code: Option Compare Database Private Sub ChooseEmployee_AfterUpdate() Filter = "(((TableEmployees.EmployeeID)=[Forms]![FormChooseEmployee]![ChooseEmployee]))" FilterOn = True [Password1] = Null [Password2] = Null [OK].Enabled = True [Password1].Visible = True [Password1].SetFocus If [Forms]![FormChooseEmployee]![ChooseEmployee].Column(2) = "" Then [Password2].Visible = True MsgBox "Please set your password by entering it in both the fields shown.", vbOKOnly Else [Password2].Visible = False End If End Sub Private Sub Exit_Click() DoCmd.Quit End Sub Private Sub Form_Open(Cancel As Integer) Filter = "False" FilterOn = True End Sub Private Sub OK_Click() If IsNull([Password1]) Then MsgBox "Enter a password.", vbOKOnly: [Password1].SetFocus: Exit Sub If [Password2].Visible = True Then If [Password1] = [Password2] Then [Password] = [Password1] Me.Dirty = False MsgBox "You must restart the application.", vbOKOnly: DoCmd.Quit Else MsgBox "Passwords do not match, please enter again.", vbOKOnly [Password1] = Null [Password2] = Null [Password1].SetFocus Exit Sub End If Exit Sub End If If [Password1] = [Password] Then [Password1].Visible = False [Password1] = Null Modal = False DoCmd.OpenForm "FormChooseEmployee", , , , , acHidden DoCmd.OpenForm "menu" 'Use the employee authorisation levels (see table) to enable or disable various buttons on the Switchboard If [CROwner] = True Then Forms![menu]![Proc].Enabled = True Else Forms![menu]![Proc].Enabled = False End If Else MsgBox "Incorrect password.", vbOKOnly [Password1] = Null [Password1].SetFocus End If End Sub
Code: Private Sub cmdRunCR02Report_Click() On Error GoTo cmdRunCR02Report_Click_Err If IsReportOpen("rpt_CR02ClassifyEditValidationLevel2ErrorRateReport") = True Then DoCmd.Close acReport, "rpt_CR02ClassifyEditValidationLevel2ErrorRateReport", acSaveNo DoCmd.OpenReport "rpt_CR02ClassifyEditValidationLevel2ErrorRateReport", acViewPreview Else End If DoCmd.OpenReport "rpt_CR02ClassifyEditValidationLevel2ErrorRateReport", acViewPreview cmdRunCR02Report_Click_Exit: Exit Sub cmdRunCR02Report_Click_Err: MsgBox Error$ Resume cmdRunCR02Report_Click_Exit End Sub
Code: Function IsReportOpen(strReportName As String) As Boolean On Error GoTo Error_Handler If Application.CurrentProject.AllReports(sRptName).IsLoaded = True Then IsReportOpen = True Else IsReportOpen = False End If Error_Handler_Exit: On Error Resume Next Exit Function Error_Handler: MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _ Err.Number & vbCrLf & "Error Source: IsReportOpen" & vbCrLf & "Error Description: " & _ Err.Description, vbCritical, "An Error has Occured!" Resume Error_Handler_Exit End Function
Code: Me.subAccountLedgerList.Form.Recordset![LEDGER1.TRANSACTION]In Access 2007 this code worked fine all the time, but not in Access 2010. In Access 2010 this works only if I select the first row of the subform, while selecting any other record it rises error 3021, apparently without reasons. In fact, using watch windows for the recordset object, and then navigating into the tree structure up to the field "LEDGER1.TRANSACTION", I can clearly see the correct value populated, by the way even into the watch window the full piece of code "Me.subAccountLedgerList.Form.Recordset![LEDGER1.TRANSACTION]" shows the label "No current record.", and it rises runtime error 3021 when the code is executed.