急！如何再次让数据环境的连接对话框出现？

Question

我用数据环境设置了一个连接，运行时会出现一个连接数据库的对话框，我觉得不错。我想在程序运行中允许用户改变数据库的连接，下面是我的代码：Sub Main()
    On Error GoTo chkErr
    If dtEnvr.conn.State <> 0 Then
        dtEnvr.conn.DefaultDatabase = ""
        dtEnvr.conn.ConnectionString = ""
        dtEnvr.conn.Close
    End If
    dtEnvr.conn.Open
    Set cn = New ADODB.Connection
    cn = dtEnvr.conn
    
chkErr:
    If Err.Number > 0 Then
        MsgBox "未知错误，数据库连接失败", vbCritical + vbOKOnly, "未知错误"
    ElseIf Err.Number < 0 Then
        MsgBox Err.Description & "程序结束。", vbInformation + vbOKOnly, "程序结束"
    Else
        Set fMainForm = New frmMain
        fMainForm.Show
    End If
End SubdtEnvr.conn.Open，这句在第一次运行时会显示那个对话框，但在别处调用这个函数时，它会直接按照原来的方式连接，从而直接显示登录失败。该怎么办呢？

Answer 1

代码应改为如下：Sub Main()
    On Error GoTo chkErr
    If dtEnvr.conn.State <> 0 Then
        dtEnvr.conn.Close
    End If
    dtEnvr.conn.Open
    Set cn = New ADODB.Connection
    cn = dtEnvr.conn
    
chkErr:
    If Err.Number > 0 Then
        MsgBox "未知错误，数据库连接失败", vbCritical + vbOKOnly, "未知错误"
    ElseIf Err.Number < 0 Then
        MsgBox Err.Description & "程序结束。", vbInformation + vbOKOnly, "程序结束"
    Else
        Set fMainForm = New frmMain
        fMainForm.Show
    End If
End SubIF里面去掉了两句，否则会出错，提示说"属性值无效。请确保键入了正确的值。"之类

Answer 2

引用OLE DB services component 1.0 type和ADO
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 IfExit_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 FunctionErr_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