如何在Excel VBA中不打开Access数据库执行其VBA函数？

ADODB连接仅支持数据查询操作，无法直接调用Access数据库内的VBA函数。针对你的需求，提供两种可行解决方案：

方案一：使用Access自动化对象并禁用自动压缩 #

通过Access Application对象执行VBA函数，同时修改数据库属性避免关闭时触发压缩：

Public Function RunAccessVBAFunc() As Variant
    Dim accApp As Object
    Dim db As Object
    Dim autoCompactOrig As Boolean
    Dim funcResult As Variant
    
    strDBPath = "\db path\db.accdb"
    strFuncName = "YourAccessVBAFunctionName" '替换为目标Access函数名
    
    '创建后台运行的Access应用实例
    Set accApp = CreateObject("Access.Application")
    accApp.Visible = False
    
    '打开数据库
    Set db = accApp.DBEngine.OpenDatabase(strDBPath)
    
    '保存原自动压缩设置并禁用
    On Error Resume Next
    autoCompactOrig = db.Properties("Auto Compact").Value
    If Err.Number <> 0 Then
        db.Properties.Append db.CreateProperty("Auto Compact", 1, False)
        autoCompactOrig = False
    End If
    On Error GoTo 0
    db.Properties("Auto Compact").Value = False
    
    '执行Access VBA函数（带参数可写成accApp.Run(strFuncName, 参数1, 参数2...)）
    funcResult = accApp.Run(strFuncName)
    
    '恢复原自动压缩设置（可选）
    db.Properties("Auto Compact").Value = autoCompactOrig
    
    '关闭资源
    db.Close
    accApp.Quit
    
    Set db = Nothing
    Set accApp = Nothing
    
    RunAccessVBAFunc = funcResult
End Function

关键说明 #

• accApp.Visible = False让Access在后台静默运行，不会弹出界面
• 先保存原自动压缩设置，执行完函数后恢复，避免修改用户数据库的默认配置

方案二：将VBA函数封装为查询（仅适用于返回数据的函数） #

如果你的Access VBA函数返回单个值或记录集，可以在Access中创建查询封装函数，再用ADODB执行该查询：

1. 在Access中创建查询qryRunFunc，SQL示例：

-- 无参数函数
SELECT YourAccessVBAFunctionName() AS FuncResult;

-- 带参数函数
SELECT YourAccessVBAFunctionName([Param1], [Param2]) AS FuncResult;

2. 在Excel VBA中用现有ADODB代码执行该查询：

Public Function RunQueryFromFunc() As Object
    Dim objCmd As Object
    Dim objRec As Object
    
    strQueryname = "qryRunFunc" '替换为封装函数的查询名
    strDBPath = "\db path\db.accdb"
    Set objCmd = CreateObject("ADODB.Command")
    
    With objCmd
        .ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                           "Data Source=" & strDBPath & ";" & _
                           "Jet OLEDB:Engine Type=5;" & _
                           "Persist Security Info=False;"
        .CommandText = strQueryname
        Set objRec = .Execute(Option:=4)
    End With
    
    Set RunQueryFromFunc = objRec
End Function

关键说明 #

• 此方法仅适用于可通过SQL调用的函数，无法执行修改数据、操作对象类的VBA过程
• 无需打开Access界面，完全通过数据连接完成操作

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