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











LinkBack URL
About LinkBacks
Register To Reply

Bookmarks