Decode error code using sequence 1,2,4,8,16,32,64.124,etc. in Access VBA

Question

To validate user input, I use different functions in Access VBA which all may produce error codes. The primary function creates a sum of all error codes and returns it to the requesting procedure. As error codes I used a binary sequence to create an unique return code (1,2,4,8,16,32,64,128, etc) Can anyone help me with a simple piece of VBA code to decode the return code to see which errors occurred, for example provide all error codes in an array? For example: error 274 is a result of 2, 16 and 256 Looked for hours, but anything I could find is written in another code like C#, Perl, etc. (which I were not able to change into VBA) Thx!

Answer 1

That's a typical greedy algorithm. Something like this will help you start:

Public Sub TestMe()

    Dim lngInput        As Long
    Dim lngTry          As Long
    Dim lngReduce       As Long: lngReduce = 10

    lngInput = 274

    While lngInput > 0
        lngTry = 2 ^ lngReduce
        lngReduce = lngReduce - 1
        If lngInput \ lngTry > 0 Then
            lngInput = lngInput - lngTry
            Debug.Print lngTry
        End If
    Wend

End Sub

You will get 256, 16, 2 printed in the console.

Answer 2

I use this function to determine whether a flag enum has a given flag - seems applicable to your case:

Public Function HasFlag(ByVal value As Long, ByVal flag As Long) As Boolean
    HasFlag = (value And flag) = flag
End Function

It's basically a small abstraction over a little bitwise check.

That way you can define an enum with your custom error codes:

Public Enum CustomErrors
    ERR_None = 0
    ERR_Foo = 2 ^ 0
    ERR_Bar = 2 ^ 1
    ERR_Fizz = 2 ^ 2
    ERR_Buzz = 2 ^ 3
    ERR_Something = 2 ^ 4
    ERR_SomethingElse = 2 ^ 5
    ERR_AnotherThing = 2 ^ 6
    ERR_SomethingWrong = 2 ^ 7
    '...
End Enum

And then if you get 274 and need to know if that contains ERR_Something you can do this:

If HasFlag(Err.Number, ERR_Something) Then
   ' handle ERR_Something
End If
If HasFlag(Err.Number, ERR_Bar) Then
   ' handle ERR_Bar
End If

Or whatever rocks your boat / suits your needs. You could make a function that iterates all the possible error codes, and returns an array or collection with all the codes for which HasFlag returns True.

---

Note: custom error codes should be added to vbObjectError to make sure you're not shadowing/overlapping the built-in error numbers, which could be quite confusing. So, if you intend to use them with Err.Raise, I'd suggest you do Err.Raise vbObjectError + theCustomErrorCode, and subtract vbObjectError from the error code when checking its flags. That way when you get error 13 you know it's a type mismatch, not a custom-flag error.

Answer 3

something like this?

Option Explicit

Sub errDecode()

    Dim errCode As Integer:   errCode = 13
    Dim errText As Variant:   errText = Array("error0", "error1", "error2", "error3", "error4", "error5", "error6", "error7")

    Dim i As Integer
    For i = 7 To 0 Step -1
        If (errCode And (2 ^ i)) > 0 Then Debug.Print errText(i),
    Next i

    Debug.Print

End Sub

Answer 4

Thx for this. Based on your example I came up with the following function that works form me. All error codes are now placed into an array AppErrCodes

Public Function AppErrCodes(lngRetCode As Long)
    On Error Resume Next
    Dim lngResult As Long
    Dim lngReduce As Long
    Dim lngTempResult() As Long
    Dim i As Integer

    lngReduce = 50 'increase this number when > 50 error codes are expected
    While lngRetCode > 0
        lngResult = 2 ^ lngReduce
        lngReduce = lngReduce - 1
        If lngRetCode \ lngResult > 0 Then
            lngRetCode = lngRetCode - lngResult
            'Debug.Print lngResult
            If lngResult > 0 Then
                ReDim Preserve lngTempResult(i)
                lngTempResult(i) = lngResult
                i = i + 1
                'Debug.Print lngTempResult(i)
            End If
        End If
    Wend
    AppErrCodes = lngTempResult
End Function