Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Run-time error 2501 when opening a form

Posted on 2016-09-13
8
Medium Priority
?
88 Views
Last Modified: 2016-09-30
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 Database
Option Explicit
Dim ProjectCount As Integer

Private Sub cmdDETAIL_Click()
If IsNull([prmEmpNo]) Then
    MsgBox ("No employee selected.")
    [prmEmpNo].SetFocus
    Exit Sub
End If
ProjectCount = NoOfProjects
If ProjectCount <> 0 Then
    Forms![fPREPROJECT]![fProjectData].SetFocus
    ProjectCount = NoOfProjects
Else
    MsgBox ("Selection has no records.")
    Exit Sub
End If
Select 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 Sub
End Select
End Sub

Private Sub cmdExit_Click()
DoCmd.Echo False
Me.Visible = False
If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAQSplashForm") = 0) Then
  DoCmd.OpenForm "fAQSplashForm"
End If
DoCmd.Echo True
End Sub

Private Sub cmdHELP_Click()
Call NavigHelp
End Sub


Private 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 If


End Sub



Private Sub Form_Activate()
'Me![fProjectData].SetFocus
'Me![fProjectData].Form![ipProjID].SetFocus
 '           .SelStart = intWhere - 1
'            .SelLength = Len(strSearch
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> vbKeyF6 Then Exit Sub
KeyCode = 0
If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAsbFac01") <> 0) Then
    Forms![fAsbFac01].SetFocus
ElseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fFacDetail01") <> 0) Then
    Forms![fFacDetail01].SetFocus
End If

End Sub

Private Sub Form_Open(Cancel As Integer)
Dim db As DAO.Database
Set db = CurrentDb()
'load the Rowsource for [prmEmpNo]
'code below performs a query and loads information
'from the EMPLOYEE table into the Rowsource
Dim EmpInfo As DAO.Recordset
Dim i As Integer
Dim qte
qte = Chr(34)
Dim prm As Parameter
Dim 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 i
Set EmpInfo = QD.OpenRecordset(dbOpenDynaset)
EmpInfo.MoveFirst
Do Until EmpInfo.EOF
    [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & EmpInfo![EmpInfo] & qte & ";" & qte & EmpInfo![Empl_No] & qte & ";"
EmpInfo.MoveNext
Loop
EmpInfo.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 fields
Forms![fPREPROJECT]![prmProjectGroup] = "AllProjects"
Forms![fPREPROJECT]![prmOpenClosed] = 2
Forms![fPREPROJECT]![prmEmpNo] = "Actv"
DoCmd.Maximize
Me![fProjectData].SetFocus

End Sub



Private Sub grpOpenClosed_Click()
Call ResetParms
End Sub



Public Function NoOfProjects()
NoOfProjects = DCount("*", "qProjectData")
End Function

Private Sub Opt1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(1)
'ME: added September 10, 2008
Call RedoSort(1)

End Sub

Private 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 test
If OptNo = 5 Then
    Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate], [Plan Date], [Project Description]"
End If
End Function

Private Sub Opt2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(2)
'ME: added September 10, 2008
Call RedoSort(2)
End Sub



Private Sub Opt3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(3)
'ME: added September 10, 2008
Call RedoSort(3)
End Sub


Private Sub Opt4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(4)
'ME: added September 10, 2008
Call RedoSort(4)
End Sub

Public Function ResetParms()
Call qProjectDataGen(Forms![fPREPROJECT], Forms![fPREPROJECT]![fProjectData].Form)
[Forms]![fPREPROJECT]![fProjectData].Requery
If [Forms]![fPREPROJECT]![fProjectData].[Form].[CurrentRecord] <> 0 Then
    Me![fProjectData].SetFocus
    Me![fProjectData].Form![ipProjID].SetFocus
End If
End Function

Private Sub Opt5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(5)
'ME: added September 10, 2008
Call RedoSort(5)
End Sub

Private Sub prmEmpNo_Click()
Call ResetParms

End Sub

Private Sub prmProjectGroup_Click()
Call ResetParms

End Sub

Open in new window




During debugging, the following line in the above code is high-lighted as an error...

Case "Complaints"
        If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01", acNormal, , , acFormEdit
0
Comment
Question by:Tammy Allen
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
  • +1
8 Comments
 
LVL 4

Expert Comment

by:bfuchs
ID: 41796968
can you open that form from DB container and edit records?
0
 
LVL 31

Expert Comment

by:Helen Feddema
ID: 41797009
Can you post the database?  I can test it in Access versions from 2003 through 2013.
0
 
LVL 19

Accepted Solution

by:
John Tsioumpris earned 2000 total points
ID: 41797791
What if
Case "Complaints":
        If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01"

Open in new window

0
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 
LVL 31

Expert Comment

by:Helen Feddema
ID: 41797971
You could try stepping through the code on the form's Open event, and see if any specific line of code triggers the error.
0
 

Author Comment

by:Tammy Allen
ID: 41818548
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 Database
Option Explicit
Dim ProjectCount As Integer

Private Sub cmdDETAIL_Click()
If IsNull([prmEmpNo]) Then
    MsgBox ("No employee selected.")
    [prmEmpNo].SetFocus
    Exit Sub
End If
ProjectCount = NoOfProjects
If ProjectCount <> 0 Then
    Forms![fPREPROJECT]![fProjectData].SetFocus
    ProjectCount = NoOfProjects
Else
    MsgBox ("Selection has no records.")
    Exit Sub
End If
Select 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 Sub
End Select
End Sub

Private Sub cmdExit_Click()
DoCmd.Echo False
Me.Visible = False
If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAQSplashForm") = 0) Then
  DoCmd.OpenForm "fAQSplashForm"
End If
DoCmd.Echo True
End Sub

Private Sub cmdHELP_Click()
Call NavigHelp
End Sub


Private 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 If


End Sub



Private Sub Form_Activate()
'Me![fProjectData].SetFocus
'Me![fProjectData].Form![ipProjID].SetFocus
 '           .SelStart = intWhere - 1
'            .SelLength = Len(strSearch
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode <> vbKeyF6 Then Exit Sub
KeyCode = 0
If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAsbFac01") <> 0) Then
    Forms![fAsbFac01].SetFocus
ElseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fFacDetail01") <> 0) Then
    Forms![fFacDetail01].SetFocus
End If

End Sub

Private Sub Form_Open(Cancel As Integer)
Dim db As DAO.Database
Set db = CurrentDb()
'load the Rowsource for [prmEmpNo]
'code below performs a query and loads information
'from the EMPLOYEE table into the Rowsource
Dim EmpInfo As DAO.Recordset
Dim i As Integer
Dim qte
qte = Chr(34)
Dim prm As Parameter
Dim 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 i
Set EmpInfo = QD.OpenRecordset(dbOpenDynaset)
EmpInfo.MoveFirst
Do Until EmpInfo.EOF
    [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & EmpInfo![EmpInfo] & qte & ";" & qte & EmpInfo![Empl_No] & qte & ";"
EmpInfo.MoveNext
Loop
EmpInfo.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 fields
Forms![fPREPROJECT]![prmProjectGroup] = "AllProjects"
Forms![fPREPROJECT]![prmOpenClosed] = 2
Forms![fPREPROJECT]![prmEmpNo] = "Actv"
DoCmd.Maximize
Me![fProjectData].SetFocus

End Sub



Private Sub grpOpenClosed_Click()
Call ResetParms
End Sub



Public Function NoOfProjects()
NoOfProjects = DCount("*", "qProjectData")
End Function

Private Sub Opt1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(1)
'ME: added September 10, 2008
Call RedoSort(1)

End Sub

Private 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 test
If OptNo = 5 Then
    Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate], [Plan Date], [Project Description]"
End If
End Function

Private Sub Opt2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(2)
'ME: added September 10, 2008
Call RedoSort(2)
End Sub



Private Sub Opt3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(3)
'ME: added September 10, 2008
Call RedoSort(3)
End Sub


Private Sub Opt4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(4)
'ME: added September 10, 2008
Call RedoSort(4)
End Sub

Public Function ResetParms()
Call qProjectDataGen(Forms![fPREPROJECT], Forms![fPREPROJECT]![fProjectData].Form)
[Forms]![fPREPROJECT]![fProjectData].Requery
If [Forms]![fPREPROJECT]![fProjectData].[Form].[CurrentRecord] <> 0 Then
    Me![fProjectData].SetFocus
    Me![fProjectData].Form![ipProjID].SetFocus
End If
End Function

Private Sub Opt5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RedoSort(5)
'ME: added September 10, 2008
Call RedoSort(5)
End Sub

Private Sub prmEmpNo_Click()
Call ResetParms

End Sub

Private Sub prmProjectGroup_Click()
Call ResetParms

End Sub

Open in new window

0
 
LVL 19

Expert Comment

by:John Tsioumpris
ID: 41818578
Well maybe its time to upload a stripped down copy to check what is going on...
0
 

Author Closing Comment

by:Tammy Allen
ID: 41823365
The new code worked and simplified the process.
0

Featured Post

[Webinar] Lessons on Recovering from Petya

Skyport is working hard to help customers recover from recent attacks, like the Petya worm. This work has brought to light some important lessons. New malware attacks like this can take down your entire environment. Learn from others mistakes on how to prevent Petya like worms.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

610 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question