Generate QR Codes in Access database report

Keywords: Access 365, QR Code

With Barcodesoft QRCode Web Service, users can generate QRCode (or any other barcode symbol) in Access database report.

No download needed! No 3rd-party software installation needed!

All you need is just internet access.

When you open the sample database, it will ask you whether to enable VBA codes. Please choose Enable Content.

Please create a "c:\temp" folder in your C Drive. All dynamic generated QRCode images will be saved in this folder.

Now, please open Forms and run Form1. Click "Download" button. It will automatically download all QR Code images to your "c:\temp" folder.

QR Code image file name will be saved to the attachment field of current record.

If you run report now, you will find each record has its own QR Code.

Now, let's look at the VBA codes

    
        Option Compare Database
        Option Explicit


        ' API declarations. For 64-bit Office, Please add PtrSafe attribute. 
        ' Don't add this attribute for 32-bit Office
        Private Declare PtrSafe Function URLDownloadToFile Lib "Urlmon" Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long) _
        As Long

        ' Download a file or a page with public access from the web.
        ' Returns 0 if success, error code if not.
        '
        ' If parameter NoOverwrite is True, no download will be attempted
        ' if an existing local file exists, thus this will not be overwritten.
        '
        ' Examples:
        '
        ' Download a file:
        '   Url = "https://www.codeproject.com/script/Membership/ProfileImages/%7Ba82bcf77-ba9f-4ec3-bbb3-1d9ce15cae23%7D.jpg"
        '   FileName = "C:\Test\CodeProjectProfile.jpg"
        '   Result = DownloadFile(Url, FileName)
        '
        ' Download a page:
        '   Url = "https://www.codeproject.com/Tips/1022704/Rounding-Values-Up-Down-By-Or-To-Significant-Figur?display=Print"
        '   FileName = "C:\Test\CodeProject1022704.html"
        '   Result = DownloadFile(Url, FileName)
        '
        ' Error codes:
        ' -2146697210   "file not found".
        ' -2146697211   "domain not found".
        ' -1            "local file could not be created."
        '
        ' 2004-12-17. Gustav Brock, Cactus Data ApS, CPH.
        ' 2017-05-25. Gustav Brock, Cactus Data ApS, CPH. Added check for local file.
        ' 2017-06-05. Gustav Brock, Cactus Data ApS, CPH. Added option to no overwrite the local file.
        '
        Public Function DownloadFile( _
        ByVal Url As String, _
        ByVal LocalFileName As String, _
        Optional ByVal NoOverwrite As Boolean) _
        As Long

        Const BindFDefault  As Long = 0
        Const ErrorNone     As Long = 0
        Const ErrorNotFound As Long = -1
        Dim Result  As Long

        If NoOverwrite = True Then
        ' Page or file should not be overwritten.
        ' Check that the local file exists.
        If Dir(LocalFileName, vbNormal) <> "" Then
        ' File exists. Don't proceed.
        Exit Function
        End If
        End If

        ' Download file or page.
        ' Return success or error code.
        Result = URLDownloadToFile(0, Url & vbNullChar, LocalFileName & vbNullChar, BindFDefault, 0)

        If Result = ErrorNone Then
        ' Page or file was retrieved.
        ' Check that the local file exists.
        If Dir(LocalFileName, vbNormal) = "" Then
        Result = ErrorNotFound
        End If
        End If

        DownloadFile = Result

        End Function


        Private Sub Command1_Click()
        Dim i, rcount As Integer
        Dim dbLib As Database
        Dim rsTable1 As Recordset
        Dim Result As Long
        Dim rsAttachment As Recordset2

        Set dbLib = CurrentDb
        Set rsTable1 = dbLib.OpenRecordset("Table1")
        rcount = rsTable1.RecordCount
        For i = 1 To rcount
        With rsTable1
        rsTable1.Edit

        Set rsAttachment = rsTable1.Fields("QRCode").Value        
        'QRCode is the name of Attachment field
        If (rsAttachment.EOF) Then
        rsAttachment.AddNew
        Else
        rsAttachment.Edit
        End If

        rsTable1.Fields(5) = "https://www.barcode-soft.com/barcode.ashx?s/qrcode/text/" + rsTable1.Fields(2) + _
        " " + rsTable1.Fields(3) + " " + rsTable1.Fields(4) + "/w/200/quiet/10/token/barcodesoft"
        ' /s/qrcode specify symbol as QRCode. 
        ' You can change symbol to code39, code128b, upca, ean13, datamatrix, etc
        ' /text/rsTable1.Fields(2) specify text to encode
        ' /w/200 specify size to 200 pixels
        ' /quiet/10 specify quiet zone to be 10 pixels
        ' /token/barcodesoft  This is the token users need to call web service. 
        ' You can use it for free with a Barcodesoft logo in the image.
        ' If you want to get rid of Barcodesoft logo, please get a license.
        Result = DownloadFile(rsTable1.Fields(5), "c:\temp\" & rsTable1.Fields(1) & ".png", True)     
        ' download dynamic QRCode image to local folder c:\temp

        rsAttachment.Fields("FileName").Value = "c:\temp\" & rsTable1.Fields(1) & ".png"              
        ' Set FileName of Attachment field
        rsAttachment.Fields("FileData").LoadFromFile "c:\temp\" & rsTable1.Fields(1) & ".png"         
        ' Set FileData of Attachment field
        rsAttachment.Update
        rsTable1.Update
        '-- Go to Next Record ---
        rsTable1.MoveNext
        End With
        Next
        End Sub