Access VBA 生成二维码的两种方式与中文编码处理

编辑于: 2026-03-30 09:37:55
创建人: 系统管理员
阅读量: 20

Hi，大家好！

背景

周六直播的时候，我用openclaw自动生成 Access文件，要求给产品编码、资产编号之类的字段直接生成二维码。当时觉得这个需求很实用，下播就开始动手做了。

在企业 Access 系统里，二维码的应用场景其实不少：

产品标签打印。
资产盘点扫码。
出入库单据关联。
会议签到和访客登记。

其实 Access 本身是有二维码生成的功能的。但如果去找第三方控件，又会遇到部署麻烦、版本兼容、授权费用等问题。

这篇文章提供两种方案，各有适用场景，都支持中文内容编码。项目源码可以直接导入使用。

一、两种方案对比

特征	方案一：在线 API 图片	方案二：Microsoft BarCode 控件
依赖	需要网络连接	需要安装 BarCode 控件
生成方式	调用 qrserver.com API 下载 PNG	控件实时渲染
输出形式	本地 PNG 图片文件	窗体内嵌控件显示
离线可用	首次生成后可离线使用已缓存图片	完全离线
中文支持	完整支持（UTF-8 URL 编码）	不支持（仅限 ASCII）
适用场景	需要导出或打印图片，或包含中文	窗体内实时预览纯英文/数字内容

两种方案可以同时使用，互不冲突。

关于方案二的中文限制：经过实际测试，Microsoft BarCode 控件的 Value 属性只能正确处理 ASCII 字符（英文、数字、符号）。传入中文时，控件会将非 ASCII 字符替换为 ?，导致扫码结果为乱码。我们尝试了多种编码绕行方案（UTF-8 字节串 + ChrW$、StrConv、Byte() 数组），均无法解决。这是该控件在中文 Windows 上的固有限制。如果需要生成包含中文的二维码，请使用方案一。

二、技术原理分析

核心挑战：中文编码

这个项目最核心的技术难点，不是"怎么生成二维码"，而是"怎么让中文正确写入二维码"。

VBA 内部使用 Unicode（UTF-16）存储字符串，但二维码的 Byte 模式默认使用 ISO-8859-1 编码，而主流扫码器在解码时默认按 UTF-8 读取。

调用在线 API 时，URL 中的中文必须正确编码为 UTF-8 百分号形式，否则服务端无法识别。方案一的核心就是在 VBA 中正确实现 UTF-8 URL 编码。

方案一的编码链路

VBA Unicode 字符串    ↓ URLEncodeUTF8() 手动 UTF-8 编码 + 百分号转义URL 中的 %E4%B8%AD 形式    ↓ PowerShell 下载本地 PNG 图片（内容已由 API 正确编码）

方案二为什么不支持中文

Microsoft BarCode 控件的 Value 属性在接收字符串时，会将非 ASCII 字符（码点 > 127）替换为 ?。我们在实测中尝试了以下方案，均无法绕过这个限制：

尝试方案	结果
直接传中文字符串	中文变成 `???`
ADODB.Stream 转 UTF-8 + `ChrW$` 逐字节映射	UTF-8 续字节 0x80-0x9F 属于 C1 控制字符，被过滤
`StrConv(utf8Bytes, vbUnicode)` 转换	经过 GBK 代码页二次转换，数据被破坏
传入 `Byte()` 数组	控件不接受 Byte 数组类型，直接报错

这是该 ActiveX 控件在中文 Windows 上的固有限制，不是 VBA 代码层面能解决的问题。

三、实现步骤

第一步：创建工具模块 modeQR

新建一个标准模块，命名为 modeQR。这个模块包含了所有二维码生成的核心逻辑。

Option Compare Database
Option Explicit

' ============================================================
' 模块: modeQR
' 用途: 二维码生成工具模块
'       方法一 - 调用在线 API 生成二维码 PNG 图片（支持中文）
'       方法二 - 为 Microsoft BarCode 控件提供数据（仅限 ASCII）
' 说明: 方法一通过 UTF-8 URL 编码完整支持中文
' ============================================================

' 获取二维码图片存储文件夹路径（当前数据库所在目录下的 qrcodes 子文件夹）
Private Function GetQRFolder() As String
    GetQRFolder = CurrentProject.Path & "\qrcodes\"
End Function

' 确保二维码文件夹存在，不存在则自动创建
Private Function EnsureQRCodeFolder() As Boolean
    On Error GoTo EH
    Dim folder As String
    folder = GetQRFolder()
    If Dir(folder, vbDirectory) = "" Then
        MkDir folder
    End If
    EnsureQRCodeFolder = True
    Exit Function
EH:
    EnsureQRCodeFolder = False
End Function

' 根据编码生成安全的文件路径（替换非法文件名字符为下划线）
' 参数: productCode - 要编码的内容
' 返回: 完整的 PNG 文件路径
Public Function GetQRCodeFilePath(ByVal productCode As String) As String
    Dim safeName As String
    safeName = Trim(Nz(productCode, ""))
    safeName = Replace(safeName, "\", "_")
    safeName = Replace(safeName, "/", "_")
    safeName = Replace(safeName, ":", "_")
    safeName = Replace(safeName, "*", "_")
    safeName = Replace(safeName, "?", "_")
    safeName = Replace(safeName, """", "_")
    safeName = Replace(safeName, "<", "_")
    safeName = Replace(safeName, ">", "_")
    safeName = Replace(safeName, "|", "_")
    GetQRCodeFilePath = GetQRFolder() & safeName & ".png"
End Function

' 将字符串进行 UTF-8 URL 编码（百分号编码）
' 处理逻辑:
'   - ASCII 字母/数字/安全字符: 原样保留
'   - 其他 ASCII: %XX
'   - U+0080~U+07FF: 2 字节 UTF-8 编码
'   - U+0800~U+FFFF: 3 字节 UTF-8 编码（中日韩字符在此范围）
' 注意: VBA 的 AscW 对 U+8000 以上字符返回负数，需加 65536 修正
Private Function URLEncodeUTF8(ByVal txt As String) As String
    Dim i As Long
    Dim ch As String
    Dim code As Long
    Dim result As String
    
    result = ""
    For i = 1 To Len(txt)
        ch = Mid$(txt, i, 1)
        code = AscW(ch)
        ' AscW 对 > U+7FFF 的字符返回负数，需转为无符号
        If code < 0 Then code = code + 65536
        
        If code < &H80 Then
            ' 1 字节 ASCII
            Select Case code
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95, 126
                result = result & ch
            Case Else
                result = result & "%" & Right$("0" & Hex(code), 2)
            End Select
        ElseIf code < &H800& Then
            ' 2 字节 UTF-8
            result = result & "%" & Right$("0" & Hex((code \ 64) Or &HC0), 2)
            result = result & "%" & Right$("0" & Hex((code And &H3F) Or &H80), 2)
        Else
            ' 3 字节 UTF-8（中文字符在此范围）
            result = result & "%" & Right$("0" & Hex((code \ 4096) Or &HE0), 2)
            result = result & "%" & Right$("0" & Hex(((code \ 64) And &H3F) Or &H80), 2)
            result = result & "%" & Right$("0" & Hex((code And &H3F) Or &H80), 2)
        End If
    Next i
    
    URLEncodeUTF8 = result
End Function

' 调用在线 API 生成二维码 PNG 图片并保存到本地
' 参数: productCode - 要编码的内容（支持中文）
' 返回: 生成的 PNG 文件完整路径，失败返回空字符串
' 说明: 使用 qrserver.com 免费 API，通过 PowerShell 同步下载
Public Function BuildQRCodeImage(ByVal productCode As String) As String
    On Error GoTo EH
    Dim pngPath As String
    Dim url As String
    Dim psCmd As String
    Dim shellCmd As String
    
    productCode = Trim(Nz(productCode, ""))
    If productCode = "" Then
        BuildQRCodeImage = ""
        Exit Function
    End If
    
    If EnsureQRCodeFolder() = False Then
        BuildQRCodeImage = ""
        Exit Function
    End If
    
    pngPath = GetQRCodeFilePath(productCode)
    url = "https://api.qrserver.com/v1/create-qr-code/?size=200x200&data=" & URLEncodeUTF8(productCode)
    
    psCmd = "try { " & _
        "$ProgressPreference='SilentlyContinue'; " & _
        "Invoke-WebRequest -Uri '" & Replace(url, "'", "''") & "' -OutFile '" & Replace(pngPath, "'", "''") & "' -UseBasicParsing | Out-Null " & _
        "} catch { exit 1 }"
    
    shellCmd = "powershell -NoProfile -ExecutionPolicy Bypass -Command """ & Replace(psCmd, """", """""") & """"
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    wsh.Run shellCmd, 0, True
    Set wsh = Nothing
    
    BuildQRCodeImage = pngPath
    Exit Function
EH:
    BuildQRCodeImage = ""
End Function

这里有一个重要的设计选择：使用 WScript.Shell 的 Run 方法而不是 VBA 内置的 Shell 函数。

原因是 VBA 的 Shell 是异步执行的，调用后会立即返回，不等 PowerShell 下载完成。而 WScript.Shell.Run 的第三个参数设为 True 时是同步阻塞的，会等到下载完成后才继续执行后续代码。如果不这样做，后面的 imgCtl.Picture = pngPath 会去读一个还不存在或还没写完的文件。

第二步：创建窗体

在窗体中放置以下控件：

控件	类型	用途
txtCode	文本框	输入要编码的内容
btnQR	按钮	触发二维码生成
Image0	图像控件	显示方案一生成的 PNG 图片
BarCodeCtrl6	Microsoft BarCode 控件	方案二实时渲染二维码

Microsoft BarCode 控件的添加方式：在窗体设计视图中，选择"插入" → "ActiveX 控件" → 找到 "Microsoft BarCode Control"。该控件随 Office 安装，但部分精简版可能缺失。

BarCode 控件需要设置以下属性：

属性	值	说明
Style	11	QR Code 类型

第三步：编写窗体事件代码

Private Sub btnQR_Click()
    RefreshProductQRCode
End Sub

Public Function RefreshProductQRCode()
    On Error GoTo EH
    Dim pngPath As String
    Dim imgCtl As Control
    Dim codeValue As String

    Set imgCtl = Me.Image0
    imgCtl.Picture = ""
    
    codeValue = Trim(Nz(Me.txtCode, ""))
    If codeValue = "" Then Exit Function
    
    ' ===== 方法一：在线 API 生成 PNG 图片 =====
    pngPath = BuildQRCodeImage(codeValue)
    
    If pngPath <> "" Then
        If Dir(pngPath) <> "" Then
            imgCtl.Picture = pngPath
            Me.Repaint
        End If
    End If
    
    ' ===== 方法二：BarCode 控件实时渲染（仅支持 ASCII） =====
    Me.BarCodeCtrl6.Object.Value = codeValue
    Me.BarCodeCtrl6.Visible = True
    Me.Repaint
    
    MsgBox "二维码已生成！", vbInformation
    Exit Function
EH:
    MsgBox "刷新二维码失败：" & Err.Description, vbExclamation
End Function

窗体代码中有几个细节值得注意：

使用 Me.Repaint 而不是 imgCtl.Requery。图像控件不支持 Requery，设置 Picture 属性后需要 Repaint 强制重绘。
BarCode 控件通过 Object.Value 直接赋值，而不是绑定 ControlSource。因为 ControlSource 接受的是字段名，不是文本值。
设置图片前先用 Dir(pngPath) 检查文件是否存在，防止异常。
BarCode 控件直接传入原始字符串即可，但仅对 ASCII 内容有效。包含中文时控件会显示为 ???，此时请以方法一的图片结果为准。