如何在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行上找不到用户定义的函数”。

- SaintWacko

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

- Christian Specht

---

太好了！如此简单的解决方法。本应该尝试一下的，但我在这方面还是新手。 - SaintWacko

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

- Fabos