I receive the following Run-time error 2501 when opening a form which was created in Access 2003, but I am trying to make available now in an Access 2013 dbase.
Option Compare DatabaseOption ExplicitDim ProjectCount As IntegerPrivate Sub cmdDETAIL_Click()If IsNull([prmEmpNo]) Then MsgBox ("No employee selected.") [prmEmpNo].SetFocus Exit SubEnd IfProjectCount = NoOfProjectsIf ProjectCount <> 0 Then Forms![fPREPROJECT]![fProjectData].SetFocus ProjectCount = NoOfProjectsElse MsgBox ("Selection has no records.") Exit SubEnd IfSelect Case prmProjectGroup Case "Complaints" If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01", acNormal, , , acFormEdit Case "Lab" If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01", acNormal, , , acFormEdit Case "ASBESTOS-INSP" If ProjectCount <> 0 Then DoCmd.OpenForm "fAsbInsp01", acNormal, , , acFormEdit Case "Inspect-PERM" If ProjectCount <> 0 Then DoCmd.OpenForm "fFacInsp01", acNormal, , , acFormEdit Case "Enforcement Cases" If ProjectCount <> 0 Then DoCmd.OpenForm "fEnforce01", acNormal, , , acFormEdit Case "Projects" If ProjectCount <> 0 Then DoCmd.OpenForm "fProject01", acNormal, , , acFormEdit Case "Permits" If ProjectCount <> 0 Then DoCmd.OpenForm "fPermRev01", acNormal, , , acFormEdit Case "Training" If ProjectCount <> 0 Then DoCmd.OpenForm "fTraining01", acNormal, , , acFormEdit Case Else MsgBox ("Type of Project selected does not have detail records.") Exit SubEnd SelectEnd SubPrivate Sub cmdExit_Click()DoCmd.Echo FalseMe.Visible = FalseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fAQSplashForm") = 0) Then DoCmd.OpenForm "fAQSplashForm"End IfDoCmd.Echo TrueEnd SubPrivate Sub cmdHELP_Click()Call NavigHelpEnd SubPrivate Sub cmdMemo_Click()If [Forms]![fPREPROJECT]![fProjectData].Form.CurrentRecord <> 0 Then glbProjID = [Forms]![fPREPROJECT]![fProjectData].Form![ipProjID] [Forms]![fPREPROJECT]![FormLink1] = [Forms]![fPREPROJECT]![fProjectData].Form![ipProjID] DoCmd.OpenForm "fProjMemoPopup"End IfEnd SubPrivate Sub Form_Activate()'Me![fProjectData].SetFocus'Me![fProjectData].Form![ipProjID].SetFocus ' .SelStart = intWhere - 1' .SelLength = Len(strSearchEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)If KeyCode <> vbKeyF6 Then Exit SubKeyCode = 0If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAsbFac01") <> 0) Then Forms![fAsbFac01].SetFocusElseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fFacDetail01") <> 0) Then Forms![fFacDetail01].SetFocusEnd IfEnd SubPrivate Sub Form_Open(Cancel As Integer)Dim db As DAO.DatabaseSet db = CurrentDb()'load the Rowsource for [prmEmpNo]'code below performs a query and loads information'from the EMPLOYEE table into the RowsourceDim EmpInfo As DAO.RecordsetDim i As IntegerDim qteqte = Chr(34)Dim prm As ParameterDim QD As DAO.QueryDef Set QD = db.QueryDefs("qCmbEmpInfo2")For i = 0 To QD.Parameters.Count - 1 Set prm = QD.Parameters(i) prm.Value = Eval(prm.Name)Next iSet EmpInfo = QD.OpenRecordset(dbOpenDynaset)EmpInfo.MoveFirstDo Until EmpInfo.EOF [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & EmpInfo![EmpInfo] & qte & ";" & qte & EmpInfo![Empl_No] & qte & ";"EmpInfo.MoveNextLoopEmpInfo.Close'this adds an additional entriy at the beginning of Rowsource[prmEmpNo].RowSource = qte & "AllActive" & qte & ";" & qte & "Actv" & qte & ";" & [prmEmpNo].RowSource'this adds additional entries to the end of Rowsource[prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "TOXICS" & qte & ";" & qte & "tox" & qte & ";"[prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "STATIONARY SOURCE" & qte & ";" & qte & "cmp" & qte & ";"[prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "AllEmployees" & qte & ";" & qte & "AllEmployees" & qte & ";"'sets values of startup parameter fieldsForms![fPREPROJECT]![prmProjectGroup] = "AllProjects"Forms![fPREPROJECT]![prmOpenClosed] = 2Forms![fPREPROJECT]![prmEmpNo] = "Actv"DoCmd.MaximizeMe![fProjectData].SetFocusEnd SubPrivate Sub grpOpenClosed_Click()Call ResetParmsEnd SubPublic Function NoOfProjects()NoOfProjects = DCount("*", "qProjectData")End FunctionPrivate Sub Opt1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(1)'ME: added September 10, 2008Call RedoSort(1)End SubPrivate Function RedoSort(OptNo As Integer)If Me.[grpOpenClosed] = OptNo Then Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate], [Due Date], [Project Description]"End If'ME: 09/03/2008: added the following for the Plan Date sorting-this is a testIf OptNo = 5 Then Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate], [Plan Date], [Project Description]"End IfEnd FunctionPrivate Sub Opt2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(2)'ME: added September 10, 2008Call RedoSort(2)End SubPrivate Sub Opt3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(3)'ME: added September 10, 2008Call RedoSort(3)End SubPrivate Sub Opt4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(4)'ME: added September 10, 2008Call RedoSort(4)End SubPublic Function ResetParms()Call qProjectDataGen(Forms![fPREPROJECT], Forms![fPREPROJECT]![fProjectData].Form)[Forms]![fPREPROJECT]![fProjectData].RequeryIf [Forms]![fPREPROJECT]![fProjectData].[Form].[CurrentRecord] <> 0 Then Me![fProjectData].SetFocus Me![fProjectData].Form![ipProjID].SetFocusEnd IfEnd FunctionPrivate Sub Opt5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(5)'ME: added September 10, 2008Call RedoSort(5)End SubPrivate Sub prmEmpNo_Click()Call ResetParmsEnd SubPrivate Sub prmProjectGroup_Click()Call ResetParmsEnd Sub
I have been working on the Access dbase using some of the suggestions provided. The following code is still not functional. I am unable to load the dbase (very exploded, large file) onto the site. The dbase is loaded with old DoCMD.OpenForm code. I believe the issue may be resulting in the condition " If Project count<>0 " based on John's observation. This condition may not be necessary to open each of the types of forms listed. Does this sound plausible as a solution.
.
Option Compare DatabaseOption ExplicitDim ProjectCount As IntegerPrivate Sub cmdDETAIL_Click()If IsNull([prmEmpNo]) Then MsgBox ("No employee selected.") [prmEmpNo].SetFocus Exit SubEnd IfProjectCount = NoOfProjectsIf ProjectCount <> 0 Then Forms![fPREPROJECT]![fProjectData].SetFocus ProjectCount = NoOfProjectsElse MsgBox ("Selection has no records.") Exit SubEnd IfSelect Case prmProjectGroup Case "Complaints" If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01", acNormal, , , acFormEdit Case "Lab" If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01", acNormal, , , acFormEdit Case "ASBESTOS-INSP" If ProjectCount <> 0 Then DoCmd.OpenForm "fAsbInsp01", acNormal, , , acFormEdit Case "Inspect-PERM" If ProjectCount <> 0 Then DoCmd.OpenForm "fFacInsp01", acNormal, , , acFormEdit Case "Enforcement Cases" If ProjectCount <> 0 Then DoCmd.OpenForm "fEnforce01", acNormal, , , acFormEdit Case "Projects" If ProjectCount <> 0 Then DoCmd.OpenForm "fProject01", acNormal, , , acFormEdit Case "Permits" If ProjectCount <> 0 Then DoCmd.OpenForm "fPermRev01", acNormal, , , acFormEdit Case "Training" If ProjectCount <> 0 Then DoCmd.OpenForm "fTraining01", acNormal, , , acFormEdit Case Else MsgBox ("Type of Project selected does not have detail records.") Exit SubEnd SelectEnd SubPrivate Sub cmdExit_Click()DoCmd.Echo FalseMe.Visible = FalseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fAQSplashForm") = 0) Then DoCmd.OpenForm "fAQSplashForm"End IfDoCmd.Echo TrueEnd SubPrivate Sub cmdHELP_Click()Call NavigHelpEnd SubPrivate Sub cmdMemo_Click()If [Forms]![fPREPROJECT]![fProjectData].Form.CurrentRecord <> 0 Then glbProjID = [Forms]![fPREPROJECT]![fProjectData].Form![ipProjID] [Forms]![fPREPROJECT]![FormLink1] = [Forms]![fPREPROJECT]![fProjectData].Form![ipProjID] DoCmd.OpenForm "fProjMemoPopup"End IfEnd SubPrivate Sub Form_Activate()'Me![fProjectData].SetFocus'Me![fProjectData].Form![ipProjID].SetFocus ' .SelStart = intWhere - 1' .SelLength = Len(strSearchEnd SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)If KeyCode <> vbKeyF6 Then Exit SubKeyCode = 0If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAsbFac01") <> 0) Then Forms![fAsbFac01].SetFocusElseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fFacDetail01") <> 0) Then Forms![fFacDetail01].SetFocusEnd IfEnd SubPrivate Sub Form_Open(Cancel As Integer)Dim db As DAO.DatabaseSet db = CurrentDb()'load the Rowsource for [prmEmpNo]'code below performs a query and loads information'from the EMPLOYEE table into the RowsourceDim EmpInfo As DAO.RecordsetDim i As IntegerDim qteqte = Chr(34)Dim prm As ParameterDim QD As DAO.QueryDef Set QD = db.QueryDefs("qCmbEmpInfo2")For i = 0 To QD.Parameters.Count - 1 Set prm = QD.Parameters(i) prm.Value = Eval(prm.Name)Next iSet EmpInfo = QD.OpenRecordset(dbOpenDynaset)EmpInfo.MoveFirstDo Until EmpInfo.EOF [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & EmpInfo![EmpInfo] & qte & ";" & qte & EmpInfo![Empl_No] & qte & ";"EmpInfo.MoveNextLoopEmpInfo.Close'this adds an additional entriy at the beginning of Rowsource[prmEmpNo].RowSource = qte & "AllActive" & qte & ";" & qte & "Actv" & qte & ";" & [prmEmpNo].RowSource'this adds additional entries to the end of Rowsource[prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "TOXICS" & qte & ";" & qte & "tox" & qte & ";"[prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "STATIONARY SOURCE" & qte & ";" & qte & "cmp" & qte & ";"[prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "AllEmployees" & qte & ";" & qte & "AllEmployees" & qte & ";"'sets values of startup parameter fieldsForms![fPREPROJECT]![prmProjectGroup] = "AllProjects"Forms![fPREPROJECT]![prmOpenClosed] = 2Forms![fPREPROJECT]![prmEmpNo] = "Actv"DoCmd.MaximizeMe![fProjectData].SetFocusEnd SubPrivate Sub grpOpenClosed_Click()Call ResetParmsEnd SubPublic Function NoOfProjects()NoOfProjects = DCount("*", "qProjectData")End FunctionPrivate Sub Opt1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(1)'ME: added September 10, 2008Call RedoSort(1)End SubPrivate Function RedoSort(OptNo As Integer)If Me.[grpOpenClosed] = OptNo Then Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate], [Due Date], [Project Description]"End If'ME: 09/03/2008: added the following for the Plan Date sorting-this is a testIf OptNo = 5 Then Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate], [Plan Date], [Project Description]"End IfEnd FunctionPrivate Sub Opt2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(2)'ME: added September 10, 2008Call RedoSort(2)End SubPrivate Sub Opt3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(3)'ME: added September 10, 2008Call RedoSort(3)End SubPrivate Sub Opt4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(4)'ME: added September 10, 2008Call RedoSort(4)End SubPublic Function ResetParms()Call qProjectDataGen(Forms![fPREPROJECT], Forms![fPREPROJECT]![fProjectData].Form)[Forms]![fPREPROJECT]![fProjectData].RequeryIf [Forms]![fPREPROJECT]![fProjectData].[Form].[CurrentRecord] <> 0 Then Me![fProjectData].SetFocus Me![fProjectData].Form![ipProjID].SetFocusEnd IfEnd FunctionPrivate Sub Opt5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Call RedoSort(5)'ME: added September 10, 2008Call RedoSort(5)End SubPrivate Sub prmEmpNo_Click()Call ResetParmsEnd SubPrivate Sub prmProjectGroup_Click()Call ResetParmsEnd Sub