VBA打开SQL Server传递查询为空，手动打开正常的问题

API 探路者

2026-7-28

Access VBA执行后传递查询无结果，手动打开正常的问题排查与解决

背景说明

我有一个连接本地SQL Server 2019 Developer实例的Access 2016数据库：

MyDbConn和MyADOParamDefinition是自定义类，用于简化ADO调用，该部分功能正常；
dbo.UserVariablesInt是存储用户临时整数变量的表，用来避免重复编写查询代码；
[impexp].[udp_ImportSpreadsheet_PersonActionsAndEvents]是执行SSIS包的存储过程，负责导入电子表格、转换数据并加载到对应表；未匹配手机号的行会存入impexp.PersonActionsAndEventsImport_CellNoMatch表，此流程运行正常。

问题描述

VBA代码执行导入流程后，通过标记“!!!!!!!”的DoCmd.OpenQuery "qryImpExpResults_PersonActions_CellNotFound"语句打开传递查询时，结果为空（测试场景下应有1条数据），但手动打开该查询能正常显示预期记录。
通过SQL Profiler排查发现：VBA触发时该查询未执行，用单独按钮触发则正常。

相关代码

VBA代码

Private Sub SetUserVariable(ByRef dbconn As MyDbConn, iVariableTypeID As Integer, vIntValue As Variant, vVarcharValue As Variant, vDatetimeValue As Variant, vDecimalValue As Variant)
On Error GoTo Err_SetUserVariable

   Dim parm(5) As New MyADOParamDefinition, cmd As ADODB.Command, i As Integer
   Const sCommandText = "[allusr].[udp_AddUpdateUserVariable]"
   Const vCommandType = adCmdStoredProc
   
    If GetCurrentStaffID > 0 Then
        Call parm(0).MakeParamDef("@StaffID", adInteger, iCurrentStaffID)
    Else
        Call parm(0).MakeParamDef("@StaffID", adInteger, Null) 'pass null to have the procedure fill in the User id of the current user
    End If
   
    Call parm(1).MakeParamDef("@VariableTypeID", adInteger, iVariableTypeID)
    Call parm(2).MakeParamDef("@VariableIntValue", adInteger, vIntValue)
    Call parm(3).MakeParamDef("@VariableVarcharValue", adVarChar, vVarcharValue, , -1)
    Call parm(4).MakeParamDef("@VariableDatetimeValue", adDate, vDatetimeValue)
    Call parm(5).MakeParamDef("@VariableDecimalValue", adDecimal, vDecimalValue, , , 18, 5)
   
    Set cmd = dbconn.RunProcedureWithParams(sCommandText, vCommandType, parm)
   
Exit_SetUserVariable:
    For i = LBound(parm) To UBound(parm)
        Set parm(i) = Nothing
    Next i
    Erase parm
    Set cmd = Nothing
    Exit Sub
   
Err_SetUserVariable:
    ShowErrorMessage Err, "SetUserVariable"
    Resume Exit_SetUserVariable
End Sub

Public Sub SetUserVariableInt(ByRef dbconn As MyDbConn, iVariableTypeID As Integer, vValue As Variant)
    Call SetUserVariable(dbconn, iVariableTypeID, vValue, Null, Null, Null)
End Sub


Private Sub ImportFromSpreadsheet(sFileLoc As String)
On Error GoTo Err_ImportFromSpreadsheet

    Dim dbcnn As New MyDbConn, bolSuccess As Boolean
    Dim parm(1 To 2) As New MyADOParamDefinition, i As Integer, cmd As ADODB.Command
   
    SetUserVariableInt dbcnn, 27, Me.txtActionID.Value
   
    Call parm(1).MakeParamDef("@ActionID", adInteger, Me.txtActionID.Value)
    Call parm(2).MakeParamDef("@FileName", adVarWChar, sFileLoc, , 250)
    Set cmd = dbcnn.RunProcedureWithParams("[impexp].[udp_ImportSpreadsheet_PersonActionsAndEvents]", adCmdStoredProc, parm)
   
    LoadPeopleList dbcnn
   
Exit_ImportFromSpreadsheet:
    For i = 1 To 2
        Set parm(i) = Nothing
    Next i
    Erase parm
    Set cmd = Nothing
    Set dbcnn = Nothing
    Exit Sub
   
Err_ImportFromSpreadsheet:
    ShowErrorMessage Err, "ImportFromSpreadsheet"
    Resume Exit_ImportFromSpreadsheet
End Sub

Private Sub cmdImportFromSpreadsheet_Click()
On Error GoTo Err_cmdImportFromSpreadsheet_Click

    Dim dbcnn As New MyDbConn
    Dim sServerDir As String, sLocalDir As String
    Const sFileName = "EventImport.xlsx"
   
    sServerDir = sDownloadsTopDir & "ZZ misc\Event Imports\\" 'The double-slashes are actually single slashes in the code; I added the extra one for StackOverflow to fix the formatting.
   
    sLocalDir = sLocalImportExportDir & GetCurrentStaffID() & "\\"
    If CheckForStaffRole(dbcnn, GetCurrentStaffIDWithConn(dbcnn), ude_StaffRole.ImportExportOperator) = False Then
        MsgBox "Cannot load from a spreadsheet. You do not have the appropriate permissions. Please contact a user admin to request 'Non-download Imports and Exports Operator' permissions."
       GoTo Exit_cmdImportFromSpreadsheet_Click
   End If

    If IsNull(Me.txtActionID.Value) Then
        MsgBox "There's no ActionID yet. Please save this action and try again."
    ElseIf CopyFileToLocalComputer(sServerDir, sFileName) = True Then
        ImportFromSpreadsheet sLocalDir & sFileName

        ' !!!!!!!This line (below) is where it gets weird!!!!!!!
         DoCmd.OpenQuery "qryImpExpResults_PersonActions_CellNotFound"
    Else
        MsgBox "There was an issue copying the file from the file server to the 'local' (i.e. the machine SQL Server is running on) for import. Import cancelled."
    End If
   
Exit_cmdImportFromSpreadsheet_Click:
    Set dbcnn = Nothing
    Exit Sub
   
Err_cmdImportFromSpreadsheet_Click:
    ShowErrorMessage Err, "cmdImportFromSpreadsheet_Click"
    Resume Exit_cmdImportFromSpreadsheet_Click
End Sub

传递查询SQL

SELECT FirstName, LastName, CellPhone 
        FROM [impexp].[PersonActionsAndEventsImport_CellNoMatch] 
        WHERE ActionID = allusr.udf_GetUserVariableInt(27,allusr.udf_CurrentStaffID())
ORDER BY LastName, FirstName

相关存储过程与函数

CREATE PROCEDURE [allusr].[udp_AddUpdateUserVariable] 
    -- Add the parameters for the stored procedure here
    @StaffID int=null,
    @VariableTypeID int,
    @VariableIntValue int=null,
    @VariableVarcharValue varchar(max)=null,
    @VariableDatetimeValue datetime=null,
    @VariableDecimalValue decimal=null
AS
BEGIN
    -- SET NOCOUNT ON added to prevent extra result sets from
    -- interfering with SELECT statements.
    SET NOCOUNT ON;

    -- Insert statements for procedure here
BEGIN TRY  
    DECLARE @PrintOutput varchar(150)
    -- SET @PrintOutput = '@StaffID = ' + CASE WHEN @StaffID IS NULL THEN 'Null' ELSE CONVERT(varchar(20), @StaffID) END
    -- RAISERROR (@PrintOutput, 10, 1) WITH NOWAIT

    IF (@StaffID IS NULL)   -- If the staffid of the current user was not supplied, find it in the Staff table
    BEGIN
        DECLARE @CurrentUser nvarchar(255) = SUSER_SNAME()
        SELECT @StaffID = [allusr].[udf_CurrentStaffID]()
        -- SET @PrintOutput = '@StaffID = ' + CASE WHEN @StaffID IS NULL THEN 'Null' ELSE CONVERT(varchar(20), @StaffID) END
        -- RAISERROR (@PrintOutput, 10, 1) WITH NOWAIT
        IF @StaffID IS NULL -- raise error if staffid wasn't found
        BEGIN
            DECLARE @msg NVARCHAR(2048) = FORMATMESSAGE(50001, @CurrentUser);
            THROW 50001, @msg, 1;
        END
    END

    -- Get the variable data type (used to determine where the variable is stored)
    DECLARE @VarDataTypeDesc varchar(20)
    DECLARE @StaffVarID int

    SELECT @VarDataTypeDesc = dt.[StaffVariableDataType] 
    FROM [list].[DataTypes] dt INNER JOIN [list].[UserVariableTypes] svt ON dt.DataTypeID = svt.DataTypeID 
    WHERE svt.VariableTypeID = @VariableTypeID

    -- update or add the staff variable (which table depends on the data type)
    IF @VarDataTypeDesc = 'int'
    BEGIN
        IF EXISTS (SELECT 1 FROM [dbo].[UserVariablesInt] WHERE StaffID = @StaffID AND [VariableTypeID] = @VariableTypeID) -- update
        BEGIN
            UPDATE [dbo].[UserVariablesInt] SET VariableIntValue = @VariableIntValue, DateLastModified = SYSDATETIME()  WHERE StaffID = @StaffID AND VariableTypeID = @VariableTypeID
        END
        ELSE -- insert
        BEGIN
            INSERT INTO [dbo].[UserVariablesInt] (StaffID, VariableTypeID, VariableIntValue) 
            VALUES (@StaffID, @VariableTypeID, @VariableIntValue)
        END
    END

    IF @VarDataTypeDesc = 'datetime'
     --N/A - snipping code

    IF @VarDataTypeDesc = 'decimal'
     --N/A - snipping code

    IF @VarDataTypeDesc = 'varchar'
     --N/A - snipping code


END TRY  
BEGIN CATCH  
    THROW;
END CATCH;  
END
GO

CREATE FUNCTION [allusr].[udf_GetUserVariableInt]
(
    -- Add the parameters for the function here
    @VariableTypeID int
    ,@StaffID int=null
)
RETURNS int
AS
BEGIN
    -- Declare the return variable here
    DECLARE @ResultVar int

    -- Add the T-SQL statements to compute the return value here
    SELECT @ResultVar = VariableIntValue
        FROM [dbo].[UserVariablesInt] v
        WHERE (StaffID = COALESCE(@StaffID, [allusr].[udf_CurrentStaffID]())) AND VariableTypeID = @VariableTypeID

    -- Return the result of the function
    RETURN @ResultVar

END

CREATE FUNCTION [allusr].[udf_CurrentStaffID]()
RETURNS int
AS
BEGIN
    -- Declare the return variable here
    DECLARE @ResultVar int

    -- Add the T-SQL statements to compute the return value here
    SELECT @ResultVar = s.StaffID 
    FROM [dbo].[Staff] s
    INNER JOIN [dbo].[StaffUsernames] su ON s.StaffID = su.StaffID
    WHERE su.UserName = SUSER_SNAME() AND s.IsActive = 1

    -- Return the result of the function
    RETURN @ResultVar

END

问题分析

核心原因是ADO连接与Access UI的连接上下文不一致：

VBA中用自定义MyDbConn（ADO连接）设置用户变量，而传递查询使用Access内置ODBC连接，两者的身份验证上下文可能不同；
SQL Server的SUSER_SNAME()在不同连接下返回结果可能不同（比如ADO用SQL身份验证，Access UI用Windows集成身份），导致udf_CurrentStaffID()返回的StaffID不匹配，查询不到对应ActionID的数据；
手动打开查询时用的是Access默认连接上下文，能正确获取当前用户StaffID，所以查询正常；VBA触发时可能因连接缓存未刷新，导致查询未执行或结果为空。

解决方案

方案1：强制刷新连接与查询缓存

在打开查询前添加代码，同步Access的连接状态并清除缓存：

' 刷新链接表，确保数据同步
CurrentDb.TableDefs("impexp.PersonActionsAndEventsImport_CellNoMatch").RefreshLink
' 刷新数据库窗口，强制重新加载查询
Application.RefreshDatabaseWindow
' 打开查询
DoCmd.OpenQuery "qryImpExpResults_PersonActions_CellNotFound"

方案2：修改为参数查询（推荐）

避免依赖用户变量，直接传入ActionID，消除上下文不一致问题：

将传递查询修改为参数查询：

SELECT FirstName, LastName, CellPhone 
FROM [impexp].[PersonActionsAndEventsImport_CellNoMatch] 
WHERE ActionID = [@ActionID]
ORDER BY LastName, FirstName

VBA中打开查询时传入参数：

Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("qryImpExpResults_PersonActions_CellNotFound")
qdf.Parameters("@ActionID") = Me.txtActionID.Value
DoCmd.OpenQuery "qryImpExpResults_PersonActions_CellNotFound"
Set qdf = Nothing

方案3：统一连接身份验证

检查MyDbConn的连接字符串，确保与Access链接表使用的连接字符串完全一致（包括身份验证方式），让SUSER_SNAME()返回相同结果，保证用户变量匹配。

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