调试代码如下:
Option Explicit
Public Function GetConnectionString(Optional forceshow As Boolean = False) As String
Dim svr, usr, pas, nt As String
Dim l As Long
Dim myconn As ADODB.Connection
    Set myconn = New ADODB.Connection
    
    svr = GetSetting("appME", "s", "server", "")
    If svr = "" Then GoTo ShowExit
    nt = GetSetting("appME", "s", "nt", "")
    usr = GetSetting("appME", "s", "user", "")
    pas = GetSetting("appME", "s", "password", "")
    If forceshow Then GoTo ShowExit
    If CStr(nt) = "1" Then
         myconn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + svr
         GetConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + svr
    Else
        myconn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + usr + ";Password=" + pas + ";Initial Catalog=yygldb;Data Source=" + svr
        GetConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + usr + ";Password=" + pas + ";Initial Catalog=yygldb;Data Source=" + svr
    End If
    
   
    myconn.ConnectionTimeout = 5
    
    
    On Error GoTo CE
    myconn.Open
    
    myconn.Close
    
    Exit Function
CE:
    MsgBox Err.Description, vbExclamation, "连接错误"
    lblinfo.Caption = "请重新填写."
ShowExit:
    Me.Server.Text = svr
    If CStr(nt) = "1" Then
        optWinNTAuth.Value = True
    Else
        optSSAuth.Value = True
        Me.user.Text = usr
        Me.pass.Text = pass
    End If
    
    Me.Show vbModal
    
    If optWinNTAuth.Value = True Then
        GetConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + Server
    Else
        GetConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + user + ";Password=" + pass + ";Initial Catalog=yygldb;Data Source=" + Server
    End If
    
    Unload Me
End FunctionPrivate Sub cmdConnect_Click()
    Dim myconn As ADODB.Connection
    Set myconn = New ADODB.Connection
    If optWinNTAuth.Value = True Then
       myconn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + Server
    Else
        myconn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + user + ";Password=" + pass + ";Initial Catalog=yygldb;Data Source=" + Server
    End If
    myconn.ConnectionTimeout = 5
    lblinfo.Caption = "正在测试连接......"
    On Error GoTo CE
    myconn.Open
    lblinfo.Caption = "测试成功"
    Me.Refresh
    myconn.Close
    If optWinNTAuth.Value = True Then
        SaveSetting "appME", "s", "nt", 1
    Else
        SaveSetting "appME", "s", "nt", 0
    End If
    
    SaveSetting "appME", "s", "server", Server
    SaveSetting "appME", "s", "user", user
    SaveSetting "appME", "s", "password", pass
    Me.Hide
    Exit Sub
CE:
    MsgBox Err.Description, vbExclamation, "连接错误"
    lblinfo.Caption = "请重新填写."
End SubPrivate Sub cmdDisconnect_Click()
    Unload Me
    End
End SubPrivate Sub Form_Load()
    optWinNTAuth.Value = True
End SubPrivate Sub optSSAuth_Click()
If optWinNTAuth.Value = True Then
    user.Enabled = False
    pass.Enabled = False
    lblUserName.Enabled = False
    lblPassword.Enabled = False
Else
     user.Enabled = True
    pass.Enabled = True
    lblUserName.Enabled = True
    lblPassword.Enabled = True
End If
End SubPrivate Sub optWinNTAuth_Click()
If optWinNTAuth.Value = True Then
    user.Enabled = False
    pass.Enabled = False
    lblUserName.Enabled = False
    lblPassword.Enabled = False
Else
     user.Enabled = True
    pass.Enabled = True
    lblUserName.Enabled = True
    lblPassword.Enabled = True
End If
End SubPrivate Sub pass_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End SubPrivate Sub Server_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    End If
End SubPrivate Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{tab}"
End Sub