Solved

Error Trapping Access code 3022

Posted on 2015-01-02
5
206 Views
Last Modified: 2015-01-03
Experts

Thank you in advance looking to incorporate code into the following code  to trap duplicates in [projectno]  currently on the on click event the standard access 3022 message appears and I want a simple message to inform the user "Duplicate Project Number please allocate a different Number"

My Code is as follows

'******************Add New Project Code ***************

Private Sub Command5_Click()
   
On Error GoTo Err_Command5_Click
     
  'Create New Project and 1st Variation
     
    Dim projectno As Long
    Dim projecttitle As String
    Dim Client As String
    Dim connection As ADODB.connection
    Dim rst As New ADODB.Recordset
    Dim datemem As Date
    Dim bymem As String
    Dim text As String
    Dim subject As String
    subject = "Receipt of First Issue Construction Drawings"
    text = "Receipt and Review of Revised Client Drawings - Review to be undertaken for Tender to Construction comparison and changes to be notified to client accordingly"
    datemem = date
    bymem = Me!AddcboCurrentEmployee.Column(1)
    projectno = Me!projectno
    projecttitle = Me!projecttitle

    'add record to project database
    Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "numberregister", connection, adOpenDynamic, adLockOptimistic
   
   'code to ADD RECORD to number register
   
   'code for checking entry already exists to add
   
    With rst
        .AddNew
        !projectno = Me!projectno
        !projecttitle = Me!projecttitle
        !Client = Me!Client
        .Update
        End With
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
        DoCmd.Close acForm, "sfsubform1"
        Me.Requery
        Forms![vo database control menu]![Sfsubform2].Requery
        Me.Refresh
        Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "vosummary", connection, adOpenDynamic, adLockOptimistic
   
   'Project Added Logo
       Me.Projectadded.Visible = True
     
  'code to ADD RECORD
    With rst
        .AddNew
        !projectnumber = projectno
        !VOnumber = 1
        !dateraised = datemem
        !raisedby = bymem
        !work = text
        !vosubject = subject
        .Update
        End With
       
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
       
Exit_Command5_Click:
   Exit Sub

 Resume Exit_Command5_Click

Err_Command5_Click:
MsgBox Err.description
Resume Exit_Command5_Click

End Sub
0
Comment
Question by:Surveyor1
  • 4
5 Comments
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
ID: 40528679
Private Sub Command5_Click()
'code to check if projectnumber already exists
'assuming projectnumber is Number type
if dcount("*","numberregister", "projectnumber= " & me.projectno) >0 then
   msgbox "Duplicate Project Number please allocate a different Number"
    me.projectno.setfocus
    exit sub
end if

'if projectnumber is TEXT use codes below
'if dcount("*","numberregister", "projectnumber= '" & me.projectno &"'") >0 then
'   msgbox "Duplicate Project Number please allocate a different Number"
'    me.projectno.setfocus
'    exit sub
'end if
0
 

Author Comment

by:Surveyor1
ID: 40529003
Thank you for your quick response

I tried your code but first got an error so played around with it for a while a made on minor change

Line 4 changed "Projectnumber" to "Projectno"

Private Sub Command5_Click()
 'code to check if projectnumber already exists
 'assuming projectnumber is Number type
 if dcount("*","numberregister", "projectnno= " & me.projectno) >0 then
    msgbox "Duplicate Project Number please allocate a different Number"
     me.projectno.setfocus
     exit sub
 end if

 'if projectnumber is TEXT use codes below
 'if dcount("*","numberregister", "projectnumber= '" & me.projectno &"'") >0 then
 '   msgbox "Duplicate Project Number please allocate a different Number"
 '    me.projectno.setfocus
 '    exit sub
 'end if

This now works well thanks

so full code looks like this now

'******************Add New Project Code ***************

Private Sub Command5_Click()
 
'Error Trapping other than code 3022

On Error GoTo Err_Command5_Click
   
'Create New Project and 1st Variation
      
    Dim projectno As Long
    Dim projecttitle As String
    Dim Client As String
    Dim connection As ADODB.connection
    Dim rst As New ADODB.Recordset
    Dim datemem As Date
    Dim bymem As String
    Dim text As String
    Dim subject As String
    subject = "Receipt of First Issue Construction Drawings"
    text = "Receipt and Review of Revised Client Drawings - Review to be undertaken for Tender to Construction comparison and changes to be notified to client accordingly"
    datemem = date
    bymem = Me!AddcboCurrentEmployee.Column(1)
    projectno = Me!projectno
    projecttitle = Me!projecttitle

       
    'add record to project database
    Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "numberregister", connection, adOpenDynamic, adLockOptimistic
   
   'code to ADD RECORD to number register
      
   'code for checking entry already exists to add
    
   'code to check if projectnumber already exists - error code trapping 3022
 'assuming projectnumber is Number type
 
 If DCount("*", "numberregister", "projectno= " & Me.projectno) > 0 Then
    MsgBox "Duplicate Project Number! please allocate a different Project Number", vbInformation, "CMWorkflow Data Required"
     Me.projectno.SetFocus
     Exit Sub
 End If

 'if projectnumber is TEXT use codes below
 'if dcount("*","numberregister", "projectnumber= '" & me.projectno &"'") >0 then
 '   msgbox "Duplicate Project Number please allocate a different Number"
 '    me.projectno.setfocus
 '    exit sub
 'end if
    
    
    With rst
        .AddNew
        !projectno = Me!projectno
        !projecttitle = Me!projecttitle
        !Client = Me!Client
        .Update
        End With
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
        DoCmd.Close acForm, "sfsubform1"
        Me.Requery
        Forms![vo database control menu]![Sfsubform2].Requery
        Me.Refresh
        Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "vosummary", connection, adOpenDynamic, adLockOptimistic
   
    
   'Project Added Logo
       Me.Projectadded.Visible = True
     
  'code to ADD RECORD
    With rst
        .AddNew
        !projectnumber = projectno
        !VOnumber = 1
        !dateraised = datemem
        !raisedby = bymem
        !work = text
        !vosubject = subject
        .Update
        End With
        
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
        
Exit_Command5_Click:
   Exit Sub
Resume Exit_Command5_Click

Err_Command5_Click:
MsgBox Err.description
Resume Exit_Command5_Click

End Sub

Open in new window






Also looking to prevent user from leaving fields blanking and getting standard error message of "invalid use of NULL"  so was going to insert the following code for each field at start of the code


 'code to check if required fields are blank and prompt user for correct input
   
    'If IsNull(Me.projectno) Or Me.projectno = "" Then
    'MsgBox "You must enter a Project Number.", vbExclamation, "CMWorkflow Required Data"
    'Me.projectno.SetFocus
    'Exit Sub
    'End If

Would this work or would or would I get a Duplicate declaration in current scope ?  if so do I just change the naming of fields ?

For example

 Dim projectno As Long

Change to

Dim AddProjectno As Long

Thanks again


Anthony
Error-message-Trapping-Error-Code-3022.J
0
 

Author Comment

by:Surveyor1
ID: 40529013
I have just got this working but not sure if code is in the right place or if it will compile  for future use without an error

Can you please advise and thank you

'******************Add New Project Code ***************

Private Sub Command5_Click()
 
    'Error Trapping other than code 3022

    On Error GoTo Err_Command5_Click
   
    'Create New Project and 1st Variation
     
    Dim projectno As Long
    Dim projecttitle As String
    Dim Client As String
    Dim connection As ADODB.connection
    Dim rst As New ADODB.Recordset
    Dim datemem As Date
    Dim bymem As String
    Dim text As String
    Dim subject As String
   
    'code to check if required fields are blank and prompt user for correct input
   
    If IsNull(Me.projectno) Or Me.projectno = "" Then
    MsgBox "You must enter a Project Number.", vbExclamation, "CMWorkflow Required Data"
    Me.projectno.SetFocus
    Exit Sub
    End If

The full code would look like this

'******************Add New Project Code ***************

Private Sub Command5_Click()
 
    'Error Trapping other than code 3022

    On Error GoTo Err_Command5_Click
   
    'Create New Project and 1st Variation
      
    Dim projectno As Long
    Dim projecttitle As String
    Dim Client As String
    Dim connection As ADODB.connection
    Dim rst As New ADODB.Recordset
    Dim datemem As Date
    Dim bymem As String
    Dim text As String
    Dim subject As String
    
    'code to check if required fields are blank and prompt user for correct input
   
    If IsNull(Me.projectno) Or Me.projectno = "" Then
    MsgBox "You must enter a Project Number.", vbExclamation, "CMWorkflow Required Data"
    Me.projectno.SetFocus
    Exit Sub
    End If
    
    'Define the data to insert into the record
    
    subject = "Receipt of First Issue Construction Drawings"
    text = "Receipt and Review of Revised Client Drawings - Review to be undertaken for Tender to Construction comparison and changes to be notified to client accordingly"
    datemem = date
    bymem = Me!AddcboCurrentEmployee.Column(1)
    projectno = Me!projectno
    projecttitle = Me!projecttitle

       
    'Add record to project database
    
    Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "numberregister", connection, adOpenDynamic, adLockOptimistic
   
   'code to ADD RECORD to number register
      
   'code for checking entry already exists to add
    
   'code to check if projectnumber already exists - error code trapping 3022
   'assuming projectnumber is Number type
 
    If DCount("*", "numberregister", "projectno= " & Me.projectno) > 0 Then
    MsgBox "Duplicate Project Number! please allocate a different Project Number", vbInformation, "CMWorkflow Data Required"
    Me.projectno.SetFocus
    Exit Sub
    End If

 'if projectnumber is TEXT use codes below
 'if dcount("*","numberregister", "projectnumber= '" & me.projectno &"'") >0 then
 '   msgbox "Duplicate Project Number please allocate a different Number"
 '    me.projectno.setfocus
 '    exit sub
 'end if
    
    
    With rst
        .AddNew
        !projectno = Me!projectno
        !projecttitle = Me!projecttitle
        !Client = Me!Client
        .Update
        End With
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
        DoCmd.Close acForm, "sfsubform1"
        Me.Requery
        Forms![vo database control menu]![Sfsubform2].Requery
        Me.Refresh
        Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "vosummary", connection, adOpenDynamic, adLockOptimistic
   
    
   'Project Added Logo
       Me.Projectadded.Visible = True
     
  'code to ADD RECORD
    With rst
        .AddNew
        !projectnumber = projectno
        !VOnumber = 1
        !dateraised = datemem
        !raisedby = bymem
        !work = text
        !vosubject = subject
        .Update
        End With
        
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
        
Exit_Command5_Click:
   Exit Sub
Resume Exit_Command5_Click

Err_Command5_Click:
MsgBox Err.description
Resume Exit_Command5_Click

End Sub
   

Private Sub Command15_Click()
On Error GoTo Err_Command15_Click


    If Me.Dirty Then Me.Dirty = False
    DoCmd.Close

Exit_Command15_Click:
    Exit Sub

Err_Command15_Click:
MsgBox Err.description
Resume Exit_Command15_Click
    End Sub

Open in new window


I would then do the same for the following fields

[Contract]
[Client]
[Projecttitle]

as follows:
'******************Add New Project Code ***************

Private Sub Command5_Click()
 
    'Error Trapping other than code 3022

    On Error GoTo Err_Command5_Click
   
    'Create New Project and 1st Variation
      
    Dim projectno As Long
    Dim projecttitle As String
    Dim Client As String
    Dim connection As ADODB.connection
    Dim rst As New ADODB.Recordset
    Dim datemem As Date
    Dim bymem As String
    Dim text As String
    Dim subject As String
    
    'code to check if required fields are blank and prompt user for correct input
   
    If IsNull(Me.projectno) Or Me.projectno = "" Then
    MsgBox "You must enter a Project Number.", vbExclamation, "CMWorkflow Required Data"
    Me.projectno.SetFocus
    Exit Sub
    End If

If IsNull(Me.AddContractno) Or Me.adddcontractno = "" Then
    MsgBox "You must enter a contract Number.", vbExclamation, "CMWorkflow Required Data"
    Me.addcontractno.SetFocus
    Exit Sub
    End If

If IsNull(Me.client) Or Me.client = "" Then
    MsgBox "You must enter a client.", vbExclamation, "CMWorkflow Required Data"
    Me.client.SetFocus
    Exit Sub
    End If

If IsNull(Me.Projecttitle) Or Me.Projecttitle = "" Then
    MsgBox "You must enter a Project Title.", vbExclamation, "CMWorkflow Required Data"
    Me.Projecttitle.SetFocus
    Exit Sub
    End If

Open in new window




Thank you

Anthony
Add-Project-Input-Message.JPG
0
 

Author Comment

by:Surveyor1
ID: 40529026
Got it working !!!

The complete code is

'******************Add New Project Code ***************

Private Sub Command5_Click()
 
    'Error Trapping other than code 3022

    On Error GoTo Err_Command5_Click
   
    'Create New Project and 1st Variation
      
    Dim projectno As Long
    Dim projecttitle As String
    Dim Client As String
    Dim connection As ADODB.connection
    Dim rst As New ADODB.Recordset
    Dim datemem As Date
    Dim bymem As String
    Dim text As String
    Dim subject As String
    
    'code to check if required fields are blank and prompt user for correct input
   
    If IsNull(Me.projectno) Or Me.projectno = "" Then
    MsgBox "You must enter a Project Number.", vbExclamation, "CMWorkflow Required Data"
    Me.projectno.SetFocus
    Exit Sub
    End If
    
    If IsNull(Me.AddContractNumber) Or Me.AddContractNumber = "" Then
    MsgBox "You must select a Contract Number.", vbExclamation, "CMWorkflow Required Data"
    Me.AddContractNumber.SetFocus
    Exit Sub
    End If
   
    If IsNull(Me.Client) Or Me.Client = "" Then
    MsgBox "You must select a Client.", vbExclamation, "CMWorkflow Required Data"
    Me.Client.SetFocus
    Exit Sub
    End If
      
    If IsNull(Me.projecttitle) Or Me.projecttitle = "" Then
    MsgBox "You must Enter a Project Title.", vbExclamation, "CMWorkflow Required Data"
    Me.projecttitle.SetFocus
    Exit Sub
    End If
        
    'Define the data to insert into the record
    
    subject = "Receipt of First Issue Construction Drawings"
    text = "Receipt and Review of Revised Client Drawings - Review to be undertaken for Tender to Construction comparison and changes to be notified to client accordingly"
    datemem = date
    bymem = Me!AddcboCurrentEmployee.Column(1)
    projectno = Me!projectno
    projecttitle = Me!projecttitle

    'Add record to project database
    
    Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "numberregister", connection, adOpenDynamic, adLockOptimistic
   
    'code to ADD RECORD to number register
      
    'code for checking entry already exists to add
    
    'code to check if projectnumber already exists - error code trapping 3022
    'assuming projectnumber is Number type
 
    If DCount("*", "numberregister", "projectno= " & Me.projectno) > 0 Then
    MsgBox "Duplicate Project Number! please allocate a different Project Number", vbInformation, "CMWorkflow Data Required"
    Me.projectno.SetFocus
    Exit Sub
    End If

    'if projectnumber is TEXT use codes below
    'if dcount("*","numberregister", "projectnumber= '" & me.projectno &"'") >0 then
    'msgbox "Duplicate Project Number please allocate a different Number"
    'me.projectno.setfocus
    'exit sub
    'end if
    
    With rst
        .AddNew
        !projectno = Me!projectno
        !projecttitle = Me!projecttitle
        !Client = Me!Client
        .Update
        End With
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
        DoCmd.Close acForm, "sfsubform1"
        Me.Requery
        Forms![vo database control menu]![Sfsubform2].Requery
        Me.Refresh
        Set connection = CurrentProject.connection
    rst.ActiveConnection = connection
    rst.Open "vosummary", connection, adOpenDynamic, adLockOptimistic
   
    
    'Project Added Logo
       Me.Projectadded.Visible = True
     
    'code to ADD RECORD
    With rst
        .AddNew
        !projectnumber = projectno
        !VOnumber = 1
        !dateraised = datemem
        !raisedby = bymem
        !work = text
        !vosubject = subject
        .Update
        End With
        
        rst.Close
        connection.Close
        Set rst = Nothing
        Set connection = Nothing
        
Exit_Command5_Click:
    Exit Sub
    Resume Exit_Command5_Click

Err_Command5_Click:
    MsgBox Err.description
    Resume Exit_Command5_Click
    End Sub

Open in new window

0
 

Author Comment

by:Surveyor1
ID: 40529106
I've requested that this question be closed as follows:

Accepted answer: 400 points for Rey Obrero (Microsoft Access MVP)'s comment #a40528679
Assisted answer: 0 points for Surveyor1's comment #a40529003

for the following reason:

Good solution and quick response
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Most if not all databases provide tools to filter data; even simple mail-merge programs might offer basic filtering capabilities. This is so important that, although Access has many built-in features to help the user in this task, developers often n…
Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

747 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now