如何在Access查询中调用VBA自定义函数 解决未定义函数报错

核心排查步骤 #

• 第一步：检查VBA模块命名 禁止和函数名重名，如果你的模块名称也为GetRole，Access会出现识别冲突，将模块重命名为和函数名不重复的名称即可，比如SysUtils、UserFunc等。
• 第二步：确认函数声明为公共类型，你当前代码中已经使用Public Function声明函数，符合调用要求，若为Private声明的函数仅能在模块内部调用，无法在查询中识别。
• 第三步：检查VBA引用完整性：打开VBA编辑器（快捷键Alt+F11），依次点击「工具」-「引用」，检查是否存在标记为「缺失」的引用项，尤其是DAO相关库（Microsoft DAO x.x Object Library），若有缺失请勾选对应版本的依赖库，也可将Dim rs As DAO.Recordset改为Dim rs As Object使用晚绑定规避引用依赖问题。
• 第四步：调整宏安全设置：Access默认会阻止未签名VBA代码运行，依次点击「文件」-「选项」-「信任中心」-「信任中心设置」-「宏设置」，选择启用所有宏，或对数据库代码进行数字签名后启用签名宏规则。

代码优化建议 #

你当前的函数存在潜在运行错误，当查询不到对应用户名时，空记录集直接取值会触发运行时错误，导致函数调用失败，优化后的代码如下：

Option Compare Database
Option Explicit

Public Function GetRole() As String
    Dim rs As DAO.Recordset
    Dim strUserName As String
    Dim strUsers As Object
    Set strUsers = CreateObject("WScript.Network")
    strUserName = strUsers.UserName
    ' 转义用户名中的单引号避免SQL语法错误，无通配符时Like可替换为=提升效率
    Set rs = CurrentDb.OpenRecordset("SELECT [Role] FROM tblUsers WHERE [UserName] = '" & Replace(strUserName, "'", "''") & "'")
    ' 新增记录集非空判断
    If Not rs.BOF And Not rs.EOF Then
        GetRole = Nz(rs.Fields("Role").Value, "")
    Else
        GetRole = "" ' 可自定义无匹配时的默认返回值
    End If
    ' 资源释放
    Set strUsers = Nothing
    rs.Close
    Set rs = Nothing
End Function

完成上述调整后，你原有的查询语句 SELECT * FROM tblUsers WHERE Role = GetRole(); 即可正常运行。

内容的提问来源于stack exchange，提问作者Fil