Excel VBA连接SQL Server终端用户遇登录弹窗问题求助

我们团队有一份共享Excel文档，用来补充会计系统的不足、追踪库存情况。我已编写VBA脚本和SQL查询实现Excel与SQL Server的对接，但终端用户执行查询刷新时，一直弹出数据库登录窗口，求解决办法。

关键信息 #

• 代码内的凭证可通过SSMS正常登录SQL Server
• 脚本在我本地电脑运行完全正常
• SQL Server部署在我的本地电脑上
• SQL Server已启用TCP/IP

现有VBA代码 #

Option Explicit

' 从外部数据源刷新数据

' 需要添加以下引用：
' - OLE Automation
' - Microsoft ActiveX Data Objects 2.8 Library
' - Microsoft Excel 16.0 Object Library
' - Microsoft Office 16.0 Object Library
' - Microsoft Outlook 16.0 Object Library

Sub RefreshQueries()
    Dim dbConnection As ADODB.Connection
    Dim dbServerName As String, qbDbName As String, aggDbName As String
    Dim connectionStr As String, qbDataArray(3), connectionName
    
    On Error GoTo ErrorHandler
    
    ' 数据库服务器信息
        dbServerName = "111.11.0.1" ' 非真实服务器IP
    
    ' 数据库名称
        qbDbName = "QbData"
        aggDbName = "NonQBInventory"
    
    ' 连接字符串（包含用户名和密码）   ##########################################################
        connectionStr = "Provider=SQLOLEDB.1;" & _
                    "Data Source=" & dbServerName & ";" & _
                    "User ID=officeUser;" & _
                    "Password=passWord;" & _
                    "Connect Timeout=10;" ' 设置连接超时时间（秒）
                    
                    ' "Encrypt=yes;" & _
                    ' "TrustServerCertificate=no;" & _ (尝试添加过这两行到连接字符串)
    
    ' 建立数据库连接
        Set dbConnection = New ADODB.Connection
        dbConnection.Open connectionStr
    
    On Error GoTo 0
     
    ' 刷新QbData数据库中的查询
        ' 填充qbDataArray
            qbDataArray(0) = "Query - GetCustomers SQL"
            qbDataArray(1) = "Query - GetItems SQL"
            qbDataArray(2) = "Query - GetOpenSOs SQL"
            qbDataArray(3) = "Query - GetUnitOfMeasures SQL"
    
        For i = 0 To UBound(qbDataArray)
            connectionName = qbDataArray(i)
            ThisWorkbook.Connections(connectionName).Refresh
        Next i
                
    ' 刷新第二个数据库中的查询   ############    后续开发用     #################################################
        'Call FillNonQbDataSqlArray
        
        'For i = 0 To UBound(nonQbData)
            'queryName = nonQbData(i)
            
            'With ThisWorkbook.Connections("Connection1") ' 替换为实际连接名称
            '    .OLEDBConnection.Connection = dbConnection
            '    .OLEDBConnection.CommandText = queryName ' 设置查询名称
            '    .Refresh
            'End With
        'Next i
    
    ' 关闭数据库连接
        dbConnection.Close
        Set dbConnection = Nothing
    
    ' 刷新工作簿中所有其他数据连接
        ThisWorkbook.RefreshAll
        Exit Sub
       
ErrorHandler:
    ' 错误处理（例如：显示消息框或写入日志文件）
        MsgBox "发生错误: " & Err.Description, vbExclamation
        On Error Resume Next
        
        ' 关闭数据库连接（如果已打开）
        If Not dbConnection Is Nothing Then
        
            If dbConnection.State = adStateOpen Then
                dbConnection.Close
            End If
            
            Set dbConnection = Nothing
        End If
End Sub

解决步骤 #

1. 修正VBA脚本的连接逻辑 #

当前代码仅自行建立了ADODB连接，但未修改Excel内置查询的连接属性，这些查询仍使用自带的无凭证连接字符串，导致刷新时弹出登录框。修改循环刷新部分的代码：

For i = 0 To UBound(qbDataArray)
    connectionName = qbDataArray(i)
    With ThisWorkbook.Connections(connectionName).OLEDBConnection
        .Connection = connectionStr ' 替换为包含凭证的连接字符串
        .SavePassword = True ' 强制保存密码，避免重复提示
    End With
    ThisWorkbook.Connections(connectionName).Refresh
Next i

2. 检查终端用户的网络与权限 #

• 确认终端用户电脑能ping通你的SQL Server IP（111.11.0.1），防火墙允许访问SQL Server默认端口1433
• 验证SQL Server的officeUser账号权限，确保终端用户通过该账号能正常访问目标数据库

3. 调整SQL Server身份验证模式 #

确保SQL Server设置为混合模式（Windows身份验证+SQL Server身份验证），避免终端用户的Windows账号无访问权限触发额外验证。

4. 测试加密连接设置 #

尝试启用加密并信任服务器证书，修改连接字符串：

connectionStr = "Provider=SQLOLEDB.1;" & _
            "Data Source=" & dbServerName & ";" & _
            "User ID=officeUser;" & _
            "Password=passWord;" & _
            "Connect Timeout=10;" & _
            "Encrypt=yes;" & _
            "TrustServerCertificate=yes;"

部分环境下未加密连接会触发验证提示。

5. 移除重复刷新逻辑 #

代码末尾的ThisWorkbook.RefreshAll会再次刷新所有连接，可能重复触发登录提示，建议直接移除该行。

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