VBA 连接到 SQL Server（我能够使用 SSMS 将用户连接到服务器）VBA to connect to SQL Server （I's Able to connect user to server using SSMS）

问：

我们的组织有一个共享的 Excel 文档，用于跟踪会计系统出现故障的库存。话虽如此，我一直在努力将两者联系起来。为此，我创建了几个脚本和 SQL 查询来完成这项工作。但是，我正在努力使查询在最终用户计算机上更新。我不断收到数据库登录提示。我需要做些什么才能让它工作？

关键信息：

1. 我可以使用 SSMS 使用代码中提供的凭据将用户登录到 SQL Server 数据库
2. 在我的计算机上运行它时，附加的代码工作正常。
3. SQL Server 在我的计算机上
4. SQL Server 已启用 TCP/IP

法典：

Option Explicit

' Refreshing data from outside data sources

' Add the required references:
' - 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
    
    ' Database server details
        dbServerName = "111.11.0.1" ' not actual server ip
    
    ' Database names
        qbDbName = "QbData"
        aggDbName = "NonQBInventory"
    
    ' Connection string (WITH USERNAME AND PASSWORD)   ##########################################################
        connectionStr = "Provider=SQLOLEDB.1;" & _
                    "Data Source=" & dbServerName & ";" & _
                    "User ID=officeUser;" & _
                    "Password=passWord;" & _
                    "Connect Timeout=10;" ' Set the connection timeout value (in seconds)
                    
                    ' "Encrypt=yes;" & _
                    ' "TrustServerCertificate=no;" & _ (TRIED ADDING THIS TO CONNECTION STRING)
    
    ' Establish the database connection
        Set dbConnection = New ADODB.Connection
        dbConnection.Open connectionStr
    
    On Error GoTo 0
     
    ' Refresh queries in QbData database
        ' Fill 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
                
    ' Refresh queries in database2   ############    FOR LATER     #################################################
        'Call FillNonQbDataSqlArray
        
        'For i = 0 To UBound(nonQbData)
            'queryName = nonQbData(i)
            
            'With ThisWorkbook.Connections("Connection1") ' Replace "Connection1" with the actual name of the connection
            '    .OLEDBConnection.Connection = dbConnection
            '    .OLEDBConnection.CommandText = queryName ' Set the query name
            '    .Refresh
            'End With
        'Next i
    
    ' Close the database connection
        dbConnection.Close
        Set dbConnection = Nothing
    
    ' Refresh all other data connections in the workbook
        ThisWorkbook.RefreshAll
        Exit Sub
       
ErrorHandler:
    ' Handle the error here (e.g., display a message box or write to a log file)
        MsgBox "An error occurred: " & Err.Description, vbExclamation
        On Error Resume Next
        
        ' Close the database connection (if it is open)
        If Not dbConnection Is Nothing Then
        
            If dbConnection.State = adStateOpen Then
                dbConnection.Close
            End If
            
            Set dbConnection = Nothing
        End If
End Sub