Generating QR Code for Access using the qr-rs library/CLI written in Rust (1 Viewer)

[monheimx9]

Hi my fellow Access enjoyers

Be aware this will be a long post :^)

Few months ago I started to learn Rust in order to give me more flexibility in my workflow and to avoid using compiled Python programs and/or managing Python environments on user's Desktops
Few days ago I wanted to write my own CLI and wrap-it in Access for QR Code Generation because I was really not satisfied with all the existing solutions, either working with web-API which are slow as hell, or using the web-controller which is more of a bandaid than a solution
The main issue was always the same, it's slow and not really practical in my use case

Long story short, someone wrote a way better CLI than the one I started to do, and I wrapped his CLI tool in VBA

Today I will present to you a solution to generate QR codes, if you're a total beginner it might not be for you but I will try to make it clear and straight to the point

1. Installing Rust

First thing you will need to install Rustup at least on one machine (the machine that will compile the program)
https://www.rust-lang.org/tools/install <- Follow this link and download Rustup-init.exe for your bitness
Launch the installation process, choose option 2) to customize installation, choose the stable toolchain and the complete version

2. Compiling the qr-rs Crate with Cargo

Next step will be compiling the program that we will call in Access

https://crates.io/crates/qr-rs

GitHub - marcoradocchia/qr-rs: A CLI utility to encode URLs or text into QR codes in various formats and colors.

A CLI utility to encode URLs or text into QR codes in various formats and colors. - marcoradocchia/qr-rs

github.com

(Thanks to Marco Radocchia for his work)
Start PowerShell and if everything is working right you can cd into the folder of your choice

After that execute this command:

cargo install qr-rs --root .

The flag "--root ." ensure that the program is installed in the current directory, do not forget the "dot" at the end ;^)

This will create an executable named "qr.exe" into the folder "bin"
In this example: "C:\Users\jerem\Desktop\Proj\test\bin\qr.exe"

3. Write the wrapping Class in Access

Just kidding, I made it for you
Open Access, open VBE IDE and add a new class module, in this exemple I named it "cQRCLI"

Option Compare Database
Option Explicit
Private m_qrCollection() As QrOptions
Private m_QrOptions As QrOptions
Private m_binaryPath As String
Private m_outputPath As String
Private m_imageExtension As String
Private m_missingArgs As Collection
Private m_arraySize As Long

Private Type QrOptions
    BackgroundColor As String
    ForegroundColor As String
    BorderSize As String
    QRScale As String
    OutputName As String
    QRPayload As String
End Type

Private Sub class_initialize()
    ReDim m_qrCollection(0)
    m_imageExtension = ".png"
    m_outputPath = Chr(34) & "C:\Users\user1\path\to\output\file\"
    m_binaryPath = Chr(34) & "C:\Users\user1\path\to\the\executable\" & "qr.exe" & Chr(34) & " "
End Sub

Public Function AddCurrentOptions() As String
    Set m_missingArgs = New Collection
    If m_QrOptions.BackgroundColor = vbNullString Then m_missingArgs.Add "BackgroundColor" 'optional
    If m_QrOptions.BorderSize = vbNullString Then m_missingArgs.Add "BorderSize" 'optional
    If m_QrOptions.ForegroundColor = vbNullString Then m_missingArgs.Add "ForegroundColor" 'optional
    'If m_QrOptions.QRScale = vbNullString Then m_missingArgs.Add "QRScale" 'optional
    If m_QrOptions.OutputName = vbNullString Then m_missingArgs.Add "OutputName" 'required
    If m_QrOptions.QRPayload = vbNullString Then m_missingArgs.Add "JSONstring" 'required
    If m_missingArgs.Count > 1 Then
        ShowMissingArgs
    Else
        If m_arraySize > 0 Then
            ReDimNotDestructive
        End If
        With m_QrOptions
            m_qrCollection(m_arraySize).BackgroundColor = .BackgroundColor
            m_qrCollection(m_arraySize).ForegroundColor = .ForegroundColor
            m_qrCollection(m_arraySize).BorderSize = .BorderSize
            m_qrCollection(m_arraySize).QRScale = .QRScale
            m_qrCollection(m_arraySize).OutputName = .OutputName
            m_qrCollection(m_arraySize).QRPayload = .QRPayload
        End With
        m_arraySize = m_arraySize + 1
        AddCurrentOptions = Replace(Replace(m_QrOptions.OutputName, Chr(34), ""), "-o ", "")
    End If
End Function

Private Function ReDimNotDestructive()
    Dim arrayIndex As Long: arrayIndex = UBound(m_qrCollection)
    Dim arrayDonor() As QrOptions
    ReDim arrayDonor(arrayIndex)
    arrayDonor = m_qrCollection
    ReDim m_qrCollection(arrayIndex + 1)
    For arrayIndex = 0 To UBound(arrayDonor)
        m_qrCollection(arrayIndex).BackgroundColor = arrayDonor(arrayIndex).BackgroundColor
        m_qrCollection(arrayIndex).ForegroundColor = arrayDonor(arrayIndex).ForegroundColor
        m_qrCollection(arrayIndex).BorderSize = arrayDonor(arrayIndex).BorderSize
        m_qrCollection(arrayIndex).QRScale = arrayDonor(arrayIndex).QRScale
        m_qrCollection(arrayIndex).OutputName = arrayDonor(arrayIndex).OutputName
        m_qrCollection(arrayIndex).QRPayload = arrayDonor(arrayIndex).QRPayload
    Next arrayIndex
End Function


Public Property Let BackgroundColor(ByVal prop As String)
    'Example: #FFF or #000 or #FF5733
    m_QrOptions.BackgroundColor = "-b " & prop & " "
End Property

Public Property Let ForegroundColor(ByVal prop As String)
    m_QrOptions.ForegroundColor = "-f " & prop & " "
End Property

Public Property Let BorderSize(ByVal prop As Long)
    m_QrOptions.BorderSize = "-B " & CStr(prop) & " "
End Property

Public Property Let QRScale(ByVal prop As Long)
    m_QrOptions.QRScale = "-s " & CStr(prop) & " "
End Property

Public Property Let OutputName(ByVal prop As String)
    m_QrOptions.OutputName = "-o " & m_outputPath & prop & m_imageExtension & Chr(34) & " "
End Property

Public Property Let QRPayload(ByVal prop As String)
    Dim rawString As String
    rawString = Replace(prop, "^", "\" & Chr(34))
    m_QrOptions.QRPayload = Chr(34) & rawString & Chr(34)
End Property

Private Sub ShowMissingArgs()
    Dim indexCol As Long
    For indexCol = 1 To m_missingArgs.Count
        Debug.Print "Missing arguments: " & m_missingArgs.Item(indexCol)
    Next indexCol
End Sub

Private Function BuildArgs(ByRef qrOpt As QrOptions) As String
    Dim argumentString As String
    With qrOpt
        argumentString = m_binaryPath & .BackgroundColor & .BorderSize & .ForegroundColor & .QRScale & .OutputName & .QRPayload
    End With
    BuildArgs = argumentString
End Function

Private Sub GenerateImage(ByVal argumentString As String, ByVal imagePath As String)
    imagePath = Replace(imagePath, Chr(34), "")
    imagePath = Replace(imagePath, "-o ", "")
    If Dir(imagePath) <> vbNullString Then
        Kill imagePath
    End If
    #If Win64 Then
        Dim objShell As Object
        Set objShell = CreateObject("Wscript.Shell")
        objShell.Run argumentString
    #Else
        Shell argumentString, vbNormalFocus
    #End If
    While Dir(imagePath) = vbNullString
        If Dir(imagePath) <> vbNullString Then Exit Sub
    Wend
End Sub

Public Sub GenerateQR()
    Dim indexArray As Long
    Dim argumentString As String
    For indexArray = 0 To UBound(m_qrCollection)
        argumentString = BuildArgs(m_qrCollection(indexArray))
        GenerateImage argumentString, m_qrCollection(indexArray).OutputName
    Next indexArray
    ReDim m_qrCollection(0)
    m_arraySize = 0
End Sub

Don't forget to edit these two variables:
m_outputPath = Chr(34) & "C:\Users\user1\path\to\output\file\"
m_binaryPath = Chr(34) & "C:\Users\user1\path\to\the\executable\" & "qr.exe" & Chr(34) & " "

And here's an exemple about how this use this Class:

Public Sub TestQR()
    Dim qr As cQRCLI
    Set qr = New cQRCLI

    qr.BackgroundColor = "#000"
    qr.ForegroundColor = "#FFF200"
    qr.BorderSize = 2
    qr.QRPayload = "{^listID^:1, ^clientID^:12347, ^date^:^02.03.2023^}"
    qr.OutputName = "example1"
    qr.AddCurrentOptions
    qr.ForegroundColor = "#0094FF"
    qr.BorderSize = 1
    qr.OutputName = "example2"
    qr.QRPayload = "{^listID^:2, ^clientID^:12347, ^date^:^02.03.2023^}"
    qr.AddCurrentOptions
    qr.OutputName = "example3"
    qr.QRPayload = "{^listID^:3, ^clientID^:12347, ^date^:^02.03.2023^}"
    qr.ForegroundColor = "#00C764"
    qr.BorderSize = 0
    qr.AddCurrentOptions
    qr.GenerateQR
End Sub

As you can see there are circumflex ^ accent in the Payload
The ^ are replaced by \"
This is if you want double quotes in a JSON string

This exemple code will generate 3 QR code images in the PNG format, inside the Class you can modify the variable m_imageExtension = ".png" to suits your needs (format supported are "jpg", "png", "svg")

Here are the 3 examples:

4. Enjoy
Enjoy a blazingly fast QR Code generation, and when I say fast, it is fast
The only caveats are the following:

1. You need to find a way to distribute the executable alongside your access application
2. I don't know how to execute "qr.exe" silently
3. The JSON formatter could be improved

If you have any questions I will try my best to answer them
Cheers


Jeremy

Edit:
The AddCurrentOptions return the path of the generated image for futher use

Edit2:
I should have posted that on the Code Repository, sorry

 

[Gasman]

Nice to see someone giving for a change.

 

[monheimx9]

I've made some small adjustments to the code, ReDimNotDestructive function makes more sense and now process call qr.exe silently

If an admin see this post, is it possible to move it into the code repository instead of here? Or should I delete this one?

Option Compare Database
Option Explicit
Private m_qrCollection() As QrOptions
Private m_QrOptions As QrOptions
Private m_binaryPath As String
Private m_outputPath As String
Private m_imageExtension As String
Private m_missingArgs As Collection
Private m_arraySize As Long

Private Type QrOptions
    BackgroundColor As String
    ForegroundColor As String
    BorderSize As String
    QRScale As String
    OutputName As String
    QRPayload As String
End Type

Private Sub class_initialize()
    ReDim m_qrCollection(0)
    m_imageExtension = ".png"
    m_outputPath = Chr(34) & "C:\Users\user1\path\to\output\file\"
    m_binaryPath = Chr(34) & "C:\Users\user1\path\to\the\executable\" & "qr.exe" & Chr(34) & " "
End Sub

Public Function AddCurrentOptions() As String
    Set m_missingArgs = New Collection
    If m_QrOptions.BackgroundColor = vbNullString Then m_missingArgs.Add "BackgroundColor" 'optional
    If m_QrOptions.BorderSize = vbNullString Then m_missingArgs.Add "BorderSize" 'optional
    If m_QrOptions.ForegroundColor = vbNullString Then m_missingArgs.Add "ForegroundColor" 'optional
    'If m_QrOptions.QRScale = vbNullString Then m_missingArgs.Add "QRScale" 'optional
    If m_QrOptions.OutputName = vbNullString Then m_missingArgs.Add "OutputName" 'required
    If m_QrOptions.QRPayload = vbNullString Then m_missingArgs.Add "JSONstring" 'required
    If m_missingArgs.Count > 1 Then
        ShowMissingArgs
    Else
        If m_arraySize > 0 Then
            ReDimNotDestructive
        End If
        With m_QrOptions
            m_qrCollection(m_arraySize).BackgroundColor = .BackgroundColor
            m_qrCollection(m_arraySize).ForegroundColor = .ForegroundColor
            m_qrCollection(m_arraySize).BorderSize = .BorderSize
            m_qrCollection(m_arraySize).QRScale = .QRScale
            m_qrCollection(m_arraySize).OutputName = .OutputName
            m_qrCollection(m_arraySize).QRPayload = .QRPayload
        End With
        m_arraySize = m_arraySize + 1
        AddCurrentOptions = Replace(Replace(m_QrOptions.OutputName, Chr(34), ""), "-o ", "")
    End If
End Function

Private Function ReDimNotDestructive()
    Dim arrayIndex As Long: arrayIndex = UBound(m_qrCollection)
    Dim arrayDonor() As QrOptions
    ReDim arrayDonor(arrayIndex)
    arrayDonor = m_qrCollection
    ReDim m_qrCollection(arrayIndex + 1)
    For arrayIndex = 0 To UBound(arrayDonor)
        m_qrCollection(arrayIndex) = arrayDonor(arrayIndex)
    Next arrayIndex
End Function


Public Property Let BackgroundColor(ByVal prop As String)
    'Example: #FFF or #000 or #FF5733
    m_QrOptions.BackgroundColor = "-b " & prop & " "
End Property

Public Property Let ForegroundColor(ByVal prop As String)
    m_QrOptions.ForegroundColor = "-f " & prop & " "
End Property

Public Property Let BorderSize(ByVal prop As Long)
    m_QrOptions.BorderSize = "-B " & CStr(prop) & " "
End Property

Public Property Let QRScale(ByVal prop As Long)
    m_QrOptions.QRScale = "-s " & CStr(prop) & " "
End Property

Public Property Let OutputName(ByVal prop As String)
    m_QrOptions.OutputName = "-o " & m_outputPath & prop & m_imageExtension & Chr(34) & " "
End Property

Public Property Let QRPayload(ByVal prop As String)
    Dim rawString As String
    rawString = Replace(prop, "^", "\" & Chr(34))
    m_QrOptions.QRPayload = Chr(34) & rawString & Chr(34)
End Property

Private Sub ShowMissingArgs()
    Dim indexCol As Long
    For indexCol = 1 To m_missingArgs.Count
        Debug.Print "Missing arguments: " & m_missingArgs.Item(indexCol)
    Next indexCol
End Sub

Private Function BuildArgs(ByRef qrOpt As QrOptions) As String
    Dim argumentString As String
    With qrOpt
        argumentString = m_binaryPath & .BackgroundColor & .BorderSize & .ForegroundColor & .QRScale & .OutputName & .QRPayload
    End With
    BuildArgs = argumentString
End Function

Private Sub GenerateImage(ByVal argumentString As String, ByVal imagePath As String)
    imagePath = Replace(imagePath, Chr(34), "")
    imagePath = Replace(imagePath, "-o ", "")
    If Dir(imagePath) <> vbNullString Then
        Kill imagePath
    End If
    #If Win64 Then
        Dim objShell As Object
        Set objShell = CreateObject("Wscript.Shell")
        objShell.Run argumentString, 0, True
    #Else
        Shell argumentString, vbNormalFocus
    #End If
    While Dir(imagePath) = vbNullString
        If Dir(imagePath) <> vbNullString Then Exit Sub
    Wend
End Sub

Public Sub GenerateQR()
    Dim indexArray As Long
    Dim argumentString As String
    For indexArray = 0 To UBound(m_qrCollection)
        argumentString = BuildArgs(m_qrCollection(indexArray))
        GenerateImage argumentString, m_qrCollection(indexArray).OutputName
    Next indexArray
    ReDim m_qrCollection(0)
    m_arraySize = 0
End Sub

 

[sonic8]

Thank you very much for sharing this solution with the community.

Few days ago I wanted to write my own CLI and wrap-it in Access for QR Code Generation [...]

Any specific reason you specifically opted for a CLI (Command Line Interface) when your goal was to use it from Access? Wouldn't it also be possible to create a WinApi like interface for VBA?

 

[monheimx9]

Thank you very much for sharing this solution with the community.

Any specific reason you specifically opted for a CLI (Command Line Interface) when your goal was to use it from Access? Wouldn't it also be possible to create a WinApi like interface for VBA?

Except for libraries like "PlaySound", "GetClipboardData" or "screenshots" I haven't used enough windows APIs to be confident with them
And since I have another CLI tool that I made in python to update the front ends for the users I wanted to try something with Rust instead, and because someone did a way better tool that the one I started to do, I've gone with his instead
The CLI might not be the best option, but in terms of simplicity it was the best choice for me, even for distributing the executable because they are stored on a network share and automaticaly copied when the front-end is open

I want to dig deeper the winAPI in the future, but there's still some stuff before that I need to learn properly

 

[DickyP]

To make the qr.exe execute quietly - assuming it is the Shell / Run statements you just need to make the WindowStyle as vbHide instead of vbNormalFocus.