Run-Time Error 3022

[Ralph Rotten]

StrSql = "Insert into........"

From a Command Button I am using the "DB.Execute strSql, dbFailOnError"
method to insert records into a table (The block of code works in all other
aspects). I want to eliminate the Access default MsgBox and replace it with
a custom MsgBox in the event of a Primary Key violation (Duplicate Record).
Despite all the examples posted, I cannot find a solution that works. I've
tried the 'On Error' form event to trap for Err.Number = 3022 as well as an
error handler within the Command Button code itself. I've tried many
variations of examples posted by Allen Browne, but still without success.
How does one code for this error, trap it, suppress the Access error MsgBox
and replace it with a custom message?

Thank you.

 

[Douglas J. Steele]

It would help seeing what you've tried...

 

[Ralph Rotten]

Douglas, Thanks for the reply. I've pasted my code below. Just a little
background, I am Oracle developer who was asked to help out with an Access
development project. Two months ago I had no previous experience with coding
for Access. I appreciate your help.

Private Sub WC49_LOAD_Click()
On Error GoTo Err_Handler

Dim LoadID As Variant
Dim ImpLocWC42 As String
Dim FileExist01 As String
Dim WS As DAO.Workspace 'Current Workspace for Transaction
Dim DB As DAO.Database 'Inside the Transaction
Dim bInTrans As Boolean 'Flag that Transaction is Active
Dim strSql01 As String 'Action Query Statements
Dim strSql02 As String 'Action Query Statements
Dim strSql03 As String 'Action Query Statements
Dim strMsg As String 'MsgBox Message
Dim ErrMsg01 As String
Dim LoadType As String


ErrMsg01 = "Record Load Was Unsuccessful Because " & _
vbCrLf & _
"Duplicate Record(s) Were Detected While " & _
vbCrLf & _
"Attempting To Load " & LoadType



'**************************************************************************
'Load Data from Excel Into Load Tables
'**************************************************************************

'Step 1: Initialize database object inside a transaction

Set DB = DBEngine(0)(0)
Set WS = DBEngine(0)
WS.BeginTrans
bInTrans = True
Set DB = WS(0)

'Step 2: Get location of Excel, Load WC42 Tables and Execute the Append

ImpLocWC42 = DLookup("[PATH]", "[1E - FILE PATH LOOKUP]", "[PATH_NUMBER] =
70") & _
DLookup("[FILE_NAME]", "[1E - FILE PATH LOOKUP]",
"[PATH_NUMBER] = 70") & ".xls"


'***************************************************
'Increment the Load ID for each Load
LoadID = DMax("[LOAD_ID]", "L6 - WC49_HISTORY") + 1

'***************************************************

'Check to See That the File Exist
FileExist01 = Dir(ImpLocWC42)

'If File Exists, Import Spreadsheet
If Len(FileExist01) <> 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, "L7 -
WC42_LOAD", ImpLocWC42, True

'Update Load
DoCmd.RunSQL ("UPDATE [L7 - WC42_LOAD] SET [L7 - WC42_LOAD].LOAD_ID =
" & LoadID & ", [L7 - WC42_LOAD].DATE_STAMP = " & "#" & Now & "#" & ";")
End If


'**************************************************
'Move from load table to history table (History table has Primary Keys
defined,
'and is the point where Err.Number 3022 should be trapped)

strSql01 = "INSERT INTO [L6 - WC49_HISTORY] (LOAD_ID, DATE_STAMP, LOC,
TRANS_CODE, ORDER_NO, SHIP_LOC, SHIP_TYPE, LNNO, SHIP_QTY, SHIP_DATE,
ITEM_ID, UNIT_COST, " & _
"UOM, EXT_COST, CURRENT_PROD_TYPE, BILL_QTY, DATE_CREATED) " & _
"SELECT LOAD_ID, DATE_STAMP, LOC, TRANS_CODE, ORDER_NO, SHIP_LOC,
SHIP_TYPE, LNNO, SUM(SHIP_QTY), CDATE(SHIP_DATE), ITEM_ID, SUM(UNIT_COST),
UOM, SUM(EXT_COST), " & _
"CURRENT_PROD_TYPE, SUM(BILL_QTY), CDATE(DATE_CREATED) " & _
"FROM [L7 - WC42_LOAD] GROUP BY LOAD_ID, DATE_STAMP, LOC,
TRANS_CODE, ORDER_NO, SHIP_LOC, SHIP_TYPE, LNNO, CDATE(SHIP_DATE), ITEM_ID,
UOM, CURRENT_PROD_TYPE, " & _
"CDATE(DATE_CREATED);"


DB.Execute strSql01, dbFailOnError

WS.CommitTrans
bInTrans = False
Set WS = Nothing
Set DB = Nothing


'Step 3: Clear out load table.

strSql03 = "DELETE * FROM [L7 - WC42_LOAD]"
DB.Execute strSql03, dbFailOnError


'Step 4: Confirm Load


strMsg = "WC42 Records Successfully Loaded => " & DB.RecordsAffected
MsgBox strMsg, vbOKOnly, "WC49 SUCCESS"


Exit_WC49_LOAD_Click:
Exit Sub


Err_Handler:

Set DB = Nothing
WS.Rollback
Set WS = Nothing
If Err.Number = 3022 Then
MsgBox ErrMsg01, vbOKOnly, "DUPLICATE RECORDS - PRIMARY KEY
VIOLATION"

ElseIf Err.Number <> 2501 And Err.Number <> 3022 Then
MsgBox "Error " & Err.Number & " - " & Err.DESCRIPTION, "WC49 LOAD"
End If

End Sub

 

[Ralph Rotten]

I May have figured this out. Thanks!

It would help seeing what you've tried...