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:

  1 2 3 4 5 6 7 8 9 10  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.

  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15  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:

 1 2 3 4  Exit $P[CODE_ELEMENT_KIND_KEYWORD] errHandler: ErrorHandler "$P[CODE_ELEMENT_NAME]" 

Which for our case would result in:

  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17  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.

 1 2 3 4 5 6 7 8 9  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.

 1 2 3 4  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.

  1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22  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.

  1 2 3 4 5 6 7 8 9 10 11 12  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.

 1 2 3 4 5 6 7 8 9  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.

  1 2 3 4 5 6 7 8 9 10 11  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, "'", """").

 1 2 3 4  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

 1 2  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.

  1 2 3 4 5 6 7 8 9 10 11  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!