Solved

Run-time error 2501 when opening a form

Posted on 2016-09-13
8
75 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 17

Accepted Solution

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

Open in new window

0
SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

 
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 17

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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

I see at least one EE question a week that pertains to using temporary tables in MS Access.  But surprisingly, I was unable to find a single article devoted solely to this topic. I don’t intend to describe all of the uses of temporary tables in t…
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.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

738 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