I am tying to raise an error under an error handler to allow for a DB transaction to be rolled back when an attempt to create duplicate model in the database happens. However, the error handler does not handle this error and instead shows me the error prompt. Please advise.
Private Sub createModelButton_Click()
'Create a new model object and set its properties
Set currentModel = New Model
currentModel.Barcode = UCase(targetBarCodeTextBox.Value)
currentModel.InBuilding29 = building29CheckBox.Value
currentModel.ModelNumber = UCase(targetModelTextBox.Value)
currentModel.ParentID = sourceComboBox.List(sourceComboBox.ListIndex, 1)
'Set the sequence number based on the selected option
If seq61Option.Value Then
currentModel.SequenceNumber = 61
ElseIf seq102Option.Value Then
currentModel.SequenceNumber = 102
ElseIf seq103Option.Value Then
currentModel.SequenceNumber = 103
End If
Dim dbConnection As ADODB.Connection
Set dbConnection = getDBConnection
'Begin a transaction
dbConnection.BeginTrans
On Error GoTo rollbackTransaction
Dim matchingBarcodes As ADODB.Recordset
Dim matchingModelNums As ADODB.Recordset
Set matchingBarcodes = executeCommand(dbConnection, "select * from model where barcode='" & currentModel.Barcode & "'")
Set matchingModelNums = executeCommand(dbConnection, "select * from model where modelnumber='" & currentModel.ModelNumber & "'")
'If there is a matching barcode or modelnumber in the database then reject the new model
If Not matchingBarcodes.EOF Or Not matchingModelNums.EOF Then
Err.Raise vbObjectError + 513, "createModelButton_Click()", currentModel.Barcode & " - " & currentModel.ModelNumber & " already exists in the database"
End If
'Insert the new model and get its ID
Dim newModelID As Long
newModelID = insertNewModel(dbConnection, currentModel.Barcode, currentModel.ModelNumber, 1)
'Get all model parameters
Dim modelParameterRecordSet As ADODB.Recordset
Set modelParameterRecordSet = getAllModelParameters(dbConnection)
Dim modelParameterID As Variant
Dim currentValue As Variant
'Insert default parameter values for the new model
If Not modelParameterRecordSet.EOF Then
Do Until modelParameterRecordSet.EOF
modelParameterID = modelParameterRecordSet.Fields("ModelParameter_ID").Value
currentValue = modelParameterRecordSet.Fields("DefaultValue").Value
insertModelParameterValue dbConnection, modelParameterID, newModelID, currentValue
modelParameterRecordSet.MoveNext
Loop
End If
modelParameterRecordSet.Close
Set modelParameterRecordSet = Nothing
'Copy parameter values from the parent model
copyModelParameterValues dbConnection, newModelID, currentModel.ParentID
'Copy limits from the parent model
copyModelLimits dbConnection, currentModel.ParentID, newModelID, "Model Copy"
'Commit the transaction
dbConnection.CommitTrans
'If the model is in Building 29, copy necessary files
If currentModel.InBuilding29 Then
'Check if the limits and sequences file already exist, if not then get the files
If Dir(localLimits & "\Seq " & currentModel.SequenceNumber & "\" & currentModel.getLimitFileName) = vbNullString Then
copyLocalFile tyqaLimits & "\Seq " & currentModel.SequenceNumber, localLimits & "\Seq " & currentModel.SequenceNumber, currentModel.getLimitFileName
End If
If Dir(localBase & "\ModelsSequences.csv") = vbNullString Then
copyLocalFile tyqaSequences, localBase, "ModelsSequences.csv"
End If
Application.ScreenUpdating = False
'Insert model into limits and sequence
insertIntoLimits
insertIntoSequence
Application.ScreenUpdating = True
End If
'Set the model ID and get new model info
currentModel.ID = newModelID
getNewModelInfo currentModel.ID, currentModel.SequenceNumber
dbConnection.Close
Set dbConnection = Nothing
Me.Hide
Exit Sub
rollbackTransaction:
'Rollback the transaction in case of an error
dbConnection.RollbackTrans
dbConnection.Close
Set dbConnection = Nothing
MsgBox "Failed to create the new model" & vbCrLf & Err.description
End Sub
Bookmarks