Option Explicit
Dim adoConn As ADODB.Connection
Private Function BuildAdoConnection(ByVal ConnectionString As String) As String
' display the ADO Connection Window (ADO DB Designer)
Dim dlViewConnection As MSDASC.DataLinks
On Error GoTo Err_BuildAdoConnection
If Not (Trim$(ConnectionString) = "") Then
Set adoConn = New ADODB.Connection
adoConn.ConnectionString = ConnectionString
Set dlViewConnection = New MSDASC.DataLinks
dlViewConnection.hWnd = Me.hWnd
If dlViewConnection.PromptEdit(adoConn) Then
BuildAdoConnection = adoConn.ConnectionString
Else
BuildAdoConnection = ConnectionString
End If
Set dlViewConnection = Nothing
Set adoConn = Nothing
Else
Set dlViewConnection = New MSDASC.DataLinks
dlViewConnection.hWnd = Me.hWnd
Set adoConn = dlViewConnection.PromptNew
BuildAdoConnection = adoConn.ConnectionString
Set dlViewConnection = Nothing
Set adoConn = Nothing
End If
Exit_BuildAdoConnection:
On Error Resume Next
If Not (adoConn Is Nothing) Then
Set adoConn = Nothing
End If
If Not (dlViewConnection Is Nothing) Then
Set dlViewConnection = Nothing
End If
On Error GoTo 0
Exit Function
Err_BuildAdoConnection:
Select Case Err
Case 0
Resume Next
Case -2147217805
adoConn.ConnectionString = ""
Resume
Case 91
Resume Exit_BuildAdoConnection
Case Else
MsgBox "Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbInformation, App.Title & " - Advisory"
Resume Exit_BuildAdoConnection
End Select
End Function
Private Sub Command1_Click()
Set adoConn = New ADODB.Connection
Dim strAdoConn As String
strAdoConn = BuildAdoConnection("") 'strAdoConn 为连接字符串
MsgBox strAdoConn
End Sub