VBA MS Access Error Handling

[nector]

I want to implement the error handling mechanism in the code below, the objectives of the error handling are to give the error message and once the user click okay the code must exit the processing immediately. This will help to ensure that the stock levels are only updated once there no errors found in the code.

Public Sub CmdSavePosMasterQTY_Click()
Dim Cancel As Integer
If IsNull(Me.txtJsonReceived) Then
Beep
MsgBox "Please Select the Product name you want to transfer data to smart invoice", vbInformation, "Wrong data"
Cancel = True
Exit Sub
End If
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim Company As New Dictionary
Dim strData As String
Dim n As Long
Dim Json As Object
Dim itemCount As Long
Dim i As Long
Dim itemz As New Dictionary
Dim transactions As Collection
Dim prm As DAO.Parameter
Dim qdf As DAO.QueryDef
On Error Resume Next
Set db = CurrentDb
Set transactions = New Collection
Set qdf = db.QueryDefs("QryStockAdjustmentPOSSalesExportZRA")
For Each prm In qdf.Parameters
     prm = Eval(prm.Name)
Next prm
Set rs = qdf.OpenRecordset(dbOpenSnapshot, dbSeeChanges)
    Set qdf = Nothing
    rs.MoveFirst
    Do While Not rs.EOF
Set Company = New Dictionary
        Company.Add "tpin", Forms!frmLogin!txtsuptpin.Value
        Company.Add "bhfId", Forms!frmLogin!txtbhfid.Value
        Company.Add "regrNm", Forms!frmLogin!txtpersoning.Value
        Company.Add "regrId", Forms!frmLogin!txtpersoning.Value
        Company.Add "modrNm", Forms!frmLogin!txtpersoning.Value
        Company.Add "modrId", Forms!frmLogin!txtpersoning.Value
        Company.Add "stockItemList", transactions
 '--- loop over all the items
        itemCount = Me.txtinternalaudit
        
        For i = 1 To itemCount
        Set itemz = New Dictionary
        transactions.Add itemz
        itemz.Add "itemSeq", i
        itemz.Add "itemCd", rs!itemCd.Value
        itemz.Add "rsdQty", rs!CurrentStock.Value
        
strData = JsonConverter.ConvertToJson(Company, Whitespace:=3)
rs.MoveNext
Next
Loop

Dim Request As Object
Dim stUrl As String
Dim Response As String
Dim requestBody As String
stUrl = "http://localhost:8080/xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
Set Request = CreateObject("MSXML2.XMLHTTP")
requestBody = strData
    With Request
        .Open "POST", stUrl, False
        .setRequestHeader "Content-type", "application/json"
        .send requestBody
        Response = .responsetext
    End With
If Request.Status = 200 Then
MsgBox Request.responsetext, vbInformation, "Internal Audit Manager"
End If

Dim rst As DAO.Recordset
Set db = CurrentDb
Set rst = db.OpenRecordset("select resultCd FROM [tblPOSStocksSold] WHERE [ItemSoldID] = " & Me.txtJsonReceived, dbOpenDynaset)
Set Json = JsonConverter.ParseJson(Request.responsetext)
'Process data.
rst.Edit
rst![resultCd] = Json("resultCd")
rst.Update

'Cleanup:
rs.Close
Set db = Nothing
Set rs = Nothing
Set qdf = Nothing
Set prm = Nothing
Set Json = Nothing
Set Company = Nothing
Set itemz = Nothing
Set transactions = Nothing

Call YYYYYYYYYYYYYY

DoCmd.OpenReport "RptPosReceipts", acViewPreview, "", "", acNormal
DoCmd.RunCommand acCmdPrint

End Sub

 

[The_Doc_Man]

First comment: You have DIM Cancel As Integer but since Cancel isn't passed in as a ByRef parameter, in effect it does nothing to later set it to TRUE. The moment you Exit Sub, the value in Cancel is lost when the subroutine's call frame dissolves.

The cases where Cancel is a parameter in the activation (e.g. Form_Open, Form_BeforeUpdate, a couple of others) are events that you can stop by using Cancel = TRUE - but your _Click sub event can't be canceled. It can only be exited before it does anything. That is a different mechanism than the Cancel method that sometimes shows up. A button can't be "unclicked" - only ignored.

Second comment: You have On Error Resume Next - which effectively turns off error handling. Therefore, the only thing left to you is that you could use code to check for errors after-the-fact of some operation, or check the parameters before you commit something. But there is no actual error handling that I can see. I only see one segment that tests anything. All it does is it pops up a message box and then continues on with whatever it was doing anyway.

Therefore, I think you need to consider specifics of what you really wanted to do rather than mention the intent to include error handling. You must first try to identify what errors you expect and then decide what you want to do with each possible error.

I want to implement the error handling mechanism in the code below

There IS no error handling in the code so your question is difficult to understand. Because we don't know your requirements, it is going to be very hard for us to respond. You have some problem analysis ahead of you.

 

[CJ_London]

Suggest write a simple macro then convert it to vba. The vba code will include some error handling which you can use as a template for your sub

 

[Pat Hartman]

This will help to ensure that the stock levels are only updated once there no errors found in the code.

Validation needs to be done in the form's BeforeUpdate event, otherwise, you're just displaying error messages but not actually protecting data since Access automatically saves the data in a bound form as long as it doesn't violate any RI rules..

Error handling looks something like this:

Private Sub Form_Load()
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset

'make flow smoother by eliminatining opening the search results form if only one client was found.

   On Error GoTo Err_Proc

    Set db = CurrentDb()
    Set qd = db.CreateQueryDef("TempQD", Forms!frmClientSearch!txtQuery)
    If DCount("*", "TempQD") = 1 Then
        DoCmd.OpenForm "frmClients", acNormal, , , , , "frmClientSearch" & ";" & Me.ClientID
        Me.Parent!chkForceClose = True      'prevent search form from reopening immediately
        DoCmd.Close acForm, Me.Parent.name, acSaveNo
    End If

Exit_Proc:
   On Error GoTo 0
   Exit Sub

Err_Proc:

    Select Case Err.Number
        Case 3012       'query already exists
            db.QueryDefs.Delete "TempQD"
            Resume
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of VBA Document Form_sfrmClient"
    End Select
End Sub

 

[xavier.batlle]

Perhaps you should use transactions to assure the stock is properly updated.

 

[Pat Hartman]

Perhaps you should use transactions to assure the stock is properly updated.

Using the correct event to actually trap errors is a lot easier than using a transaction.