I can imagine some of you are still out there having to maintain a project built for Microsoft Access, and having all sorts of fancy features written in Visual Basic for Applications. I am one of you.

So since Access is a nightmare to do proper debugging and error reporting once you’re used to modern tools, and I find I rely too much on my client to give me proper feedback, I decided to see if I can make life easier.

As a little use case, we’ll use the following code:

Sub thisSubBreaks()

Dim myString() As String
Dim myLong As Long

myString = Split("A lot of words?", " ")

myLong = myString(1) 'We can't store a String in a Long, so we'll get a Type Mismatch

End Sub

My goal is to have each error reported automatically in Sentry, and have a screenshot attached to get a view of what might have been happening at the time of the error. There should also pop-up a message at the client’s end saying an error occured, and that all power has been diverted to solving it.

Taking screenshots might involve storing information which should not be stored outside the client’s systems, and perhaps should never be seen by anyone. Make sure you take that into account.

Getting the error

There are various ways to get the location of the error, some more precise than others, but they all involve some clunky and awful mechanism. You can get the line number generating the error, and parse that using the Erl object, by prepending each line (or perhaps just the lines that you expect to go wrong someday), but… No.

Sub thisSubBreaks()

      Dim myString() As String
      Dim myLong As Long

10    myString = Split("A lot of words?", " ")

20    On Error GoTo errHandler

30    myLong = myString(1)

errHandler:
40    Debug.Print Erl  'This prints 30

End Sub

So since I’m not looking forward to, next to the code itself, start maintaining line numbers, I look for different ways to get the error location. I’ve written a global Public Sub ErrorHandler(), which I’ll explain below. We’re going to call this whenever an error happens. But that still leaves us wondering where the error took place, since the Err object only contains info about the error, but nothing about its origin.

For that we need to add some context. The next best thing is to provide a name to our ErrorHandler(callerName As String). In each call to ErrorHandler, we’re going to add the name of the caller, since that will be globally unique. There’s no way to get the name of the function programmatically, so to still do this relatively easily when you have many code blocks I recommend using the template function in MZ-Tools.

The template is:

Exit $P[CODE_ELEMENT_KIND_KEYWORD]

errHandler:
ErrorHandler "$P[CODE_ELEMENT_NAME]"

Which for our case would result in:

Sub thisSubBreaks()

Dim myString() As String
Dim myLong As Long

On Error GoTo errHandler

myString = Split("A lot of words?", " ")

myLong = myString(1)

Exit Sub

errHandler:
ErrorHandler "thisSubBreaks"

End Sub

Now that we have our error handling in place, and a name to have a hint to the source of the error, we can add to the knowledge about the error by getting a screenshot.

Getting a screenshot

Since asking for proper screenshots isn’t always doable for a client (getting blurry photos of a screen, missing the information you need, isn’t helpful). So we’ll be writing a function that takes a screenshot, and prepares it for sending across the internet.

There are various ways to get a screenshot. You can have a screenshot stored in the clipboard or write it to a file directly. You can use shell functions to make that happen or just send keys as if the user is doing it. But man… Finding out how that works pops up examples which are clunky, unreadable, and contain way too much information. So I don’t have a clue what the code is actually doing, and why. What’s worse, most of them assume early binding, which in my case always seems to cause more problems than they solve. So this example only uses late binding and has no external dependencies.

We’re going to use a relatively new screenshot function in Windows, by having it written directly to a file. This may not work on all Windows flavours. This way we don’t have to interact with the clipboard, which I found to be unneccessarily complex.

First off, we need to declare we’re going to use keyboard events in our code, and tell the code how that would work. For this we declare the following above any code blocks. Options for clarity.

Option Compare Database
Option Explicit

Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_SNAPSHOT = &H2C
Private Const VK_WIN = &H5B
Private Const KEYEVENTF_KEYUP = &H2

We’re going to use 2 keys, and 2 directions. VK_SNAPSHOT is the PrtSc key, VK_WIN is the key, and KEYEVENTF_KEYUP is letting go of the key. The key down event doesn’t need a Const.

Now we take a screenshot inside our code block.

keybd_event VK_WIN, 1, 0, 0
keybd_event VK_SNAPSHOT, 1, 0, 0
keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0
keybd_event VK_WIN, 1, KEYEVENTF_KEYUP, 0

Simple as that. It will be stored inside a standard location - %USERPROFILE%\Pictures\Screenshots. Let’s just hope your client hasn’t changed that for some reason. This location is language independent, so you can use this code on any locale.

Sending the screenshot

My challenge here was to get a binary across the internet using only VBA. For this I decided to encode the image as base64, and send that as an HTTP payload.

First we get the latest .png from the screenshots directory.

Dim Directory As String
Dim fileName As String
Dim MostRecentFile As String
Dim MostRecentDate As Date

Directory = Environ("USERPROFILE") & "\Pictures\Screenshots\"

fileName = Dir(Directory & "*.png")

If fileName <> "" Then
    MostRecentFile = fileName
    MostRecentDate = FileDateTime(Directory & fileName)
    Do While fileName <> ""
        If FileDateTime(Directory & fileName) > MostRecentDate Then
             MostRecentFile = fileName
             MostRecentDate = FileDateTime(Directory & fileName)
        End If
        fileName = Dir
    Loop
End If

MostRecentFile = Directory & MostRecentFile

We assume a screenshot was taken. If no images were found, you can test that using MostRecentFile = "", and act accordingly.

Now that we have the full path to the latest file in MostRecentFile, we will encode it to base64. First we load it into an array of bytes.

Dim bytes
Dim objXML As Object
Dim objNode As Object
Dim response As String

With CreateObject("ADODB.Stream")
    .Open
    .Type = ADODB.adTypeBinary
    .LoadFromFile MostRecentFile
    bytes = .Read
    .Close
End With

Now we can encode it to base64.

Dim payload As String

With CreateObject("MSXML2.DOMDocument")
    With .createElement("b64")
        .DataType = "bin.base64"
        .nodeTypedValue = bytes
        payload = .Text
    End With
End With

And send it along. At https://example.com/upload_image I have a Flask server waiting to receive a POST, to process the image further. It sends a response with a unique URL where the screenshot can be found. We can use that in our error reporting code in the next section.

Dim url As String
Dim response As String

url = "https://example.com/upload_image"

With CreateObject("MSXML2.XMLHTTP")
    .Open "POST", url, False
    .setRequestHeader "Content-Type", "application/json"
    .send "{""file_base64"": """ & objNode.Text & """}"
    response = .responseText
End With

Sending the error

Now it’s time to send our error somewhere. I decided to send it to my own instance of Sentry. You can of course also send it to for example the GitLab API, whatever works for you.

Remember our Public Sub ErrorHandler(callerName As String)? We’ll be using that to send our stuff to.

Sentry expects a JSON containing the error information. So we’re going to build that based on the information we have. This has some quirks, since VBA Strings only allow double quotes around it, and JSON really wants to have double quotes as well. We will solve that using a simple Replace(data, "'", """").

Dim data As String
data = "{`exception`: {`values`: [{`number`: `" & Err.Number & "`, `type`: `" & Err.Description & "`}]}," & _
"`tags`:{`module`:`" & callerName & "`, `username`: `" & TempVars!WIN_USERNAME & "`, `application`: `" & Err.Source & "`" & image_url & "}, " & _
"`release`: `" & TempVars!COMMIT_SHA & "`}"

There are various things going on here:

  • Err.Number - This will give you the unique VBA error number so you know exactly what kind of error was triggered.
  • Err.Description - This is the error description by VBA. It may contain single quotes, that is why we use backticks when building the JSON.
  • callerName - The name we set to reference the code block calling. ErrorHandler
  • TempVars!WIN_USERNAME - A TempVar I use to store the Windows username of the account which encountered the error.
  • Err.Source - The name of the Access Database application.
  • image_url - The URL of where I stored the screenshot we stored earlier.
  • TempVars!COMMIT_SHA - A TempVar I use to store the version of the application, as the short Git commit SHA.

Now that we have a beautiful JSON string, it needs to become proper JSON so we can send it. For this we need to make "s out of the `s. We do this with a simple

Dim json As String
json = Replace(data, "`", """")

Now we can send our payload. First I set the url and then use an MSXML2.XMLHTTP object using late binding. This should be quite self explanatory.

Dim url As String
Dim sentryDSN As String
url = "https://sentry.example.com/api/2/store/"
sentryDSN = "y0urpubl1cs3ntrydsn"

With CreateObject("MSXML2.XMLHTTP")
    .Open "POST", url, False
    .setRequestHeader "Content-Type", "application/json"
    .setRequestHeader "X-Sentry-Auth", "Sentry sentry_version=7, sentry_key=" & sentryDSN & ", sentry_client=vba-custom/0.1"
    .send json
End With

The sentry_client string can be anything. It is used to identify which Sentry SDK sent the payload.

And now your error pops up in Sentry. Give it a try!

vba error screenshot