sql-server - 如何从 VBA 中的函数返回 ADODB.Connection？

Question

我有一个大型 Access VBA/SQL Server 应用程序。在每个函数中都有相同的 ADODB 连接。

如何用每次都可以调用的单个函数替换它们以节省空间。

Public Function ConnectionString() As ADODB.Connection
    Dim CN As ADODB.Connection
    
    Set CN = New ADODB.Connection
        
    With CN
        .Provider = "Microsoft.Access.OLEDB.10.0"
        .Properties("Data Provider").Value = "SQLOLEDB"
        .Properties("Data Source").Value = DLookup("Source", "tbl_Connection")
        .Properties("Initial Catalog").Value = DLookup("Catalog", "tbl_Connection")
        .Properties("Integrated Security").Value = SSPI
        .Open
    End With
        
    ConnectionString = CN
    
End Function

似乎这应该返回该连接，但有一条错误消息：

未找到用户定义的函数

就行了ConnectionString = CN。

Answer 1

您需要Set返回值：

Set ConnectionString = CN

---

另外，如果它始终是相同的 ADODB 连接，您可以将它保存在一个变量中并从那里“回收”它，因此连接的实际创建只发生一次（当ConnectionString第一次调用该函数时）。

Private CN As ADODB.Connection 'variable in the module - NOT in the function

Public Function ConnectionString() As ADODB.Connection

If CN Is Nothing Then

    Set CN = New ADODB.Connection

    With CN
        'do stuff
    End With

End If

Set ConnectionString = CN

End Function

Answer 2

From sub caller:
    Dim DBConnection As New ADODB.Connection
    Call getDBConnection(ServerInfo, DBConnection)
The sub called:

Public Sub getDBConnection(ByRef paramServerInfo As ConnState, ByRef pCN As ADODB.Connection)
    Dim flagConnect As Boolean
    Dim errConnect As String
    Dim optionConn As String
    Dim strConn As String
    
    optionConn = "16427"
    strConn = "Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=""" & _
            "DRIVER={" & paramServerInfo.ODBC & "};" & _
            "DATABASE=" & paramServerInfo.Database & ";" & _
            "SERVER=" & paramServerInfo.Server & ";" & _
            "USER=" & paramServerInfo.UserName & ";" & _
            "PASSWORD=" & paramServerInfo.Password & ";" & _
            "Port=" & paramServerInfo.Port & ";" & _
            "OPTION=" & optionConn & ";"
    
    On Error Resume Next
    paramServerInfo.Conneted = False
    Do
        pCN.CursorLocation = adUseClient
        pCN.Open strConn
        paramServerInfo.Conneted = Not pCN Is Nothing
        paramServerInfo.LastMsg = Err.Description
        If Not paramServerInfo.Conneted Then
            If MsgBox("Existe un problema al intentar conectar con la Base de Datos" & vbCrLf & paramServerInfo.LastMsg & vbCrLf & "Por favor determine que hacer:", vbCritical + vbAbortRetryIgnore) = vbAbort Then
                Exit Sub
            End If
        End If
    Loop Until paramServerInfo.Conneted
End Sub