vb+SQL 的连接问题

Question

dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.Provider = "SQLOLEDB.1"
conn.ConnectionString = "Persist Security Info=False;Initial Catalog=CulpritInfoSystem;Data Source=ServerPC"
conn.Open , "sa", ""如果SQL服务器没开，程序执行到这里就会停止响应好长时间，然后发生运行时错误。
请问如何当SQL服务器没开时给于提示，最好不出现太长的停止响应。
我试过 On Err GoTo 也不行

Answer 1

增加参数
Connect Timeout=1

Answer 2

conn.ConnectionTimeout=5ConnectionTimeout 属性
      指示在终止尝试和产生错误前建立连接期间所等待的时间。设置和返回值设置或返回指示等待连接打开的时间的长整型值（单位为秒）。默认值为 15。说明如果由于网络拥塞或服务器负载过重导致的延迟使得必须放弃连接尝试时，请使用 Connection 对象的 ConnectionTimeout 属性。如果打开连接前所经过的时间超过 ConnectionTimeout 属性上设置的时间，将产生错误，并且 ADO 将取消该尝试。如果将该属性设置为零，ADO 将无限等待直到连接打开。请确认正在对其编写代码的提供者会支持 ConnectionTimeout 功能。连接关闭时 ConnectionTimeout 属性为读/写，而打开

Answer 3

Public adoCN As New ADODB.Connection       '定义数据库的连接存放数据和代码Public SqlCommand As New ADODB.Command     '定义 SQL 命令Dim adoDateTime As New ADODB.Recordset     '获取 NT-SERVER 时间'***********************************************************************
'*  功能：与 SQL SERVER 数据库建立连接并取出服务器时间
'***********************************************************************
Public Function OpenConnection() As String '打开数据库
    On Error GoTo SQLConErr
    With adoCN
        .CursorLocation = adUseClient
        .Provider = "sqloledb"
        .Properties("Data Source").Value = cNtServerName
        .Properties("Initial Catalog").Value = cDatabaseName
        .Properties("User ID") = cSQLUserName
        .Properties("Password") = cSQLPassword
        .Properties("prompt") = adPromptNever
        .ConnectionTimeout = 15  ‘可以改这个时间
        .Open
        
        If .State = adStateOpen Then
            adoDateTime.Open "select getdate()", adoCN, adOpenStatic, adLockOptimistic
            cServerDate = Format(adoDateTime(0), "yyyy-mm-dd")
            cServertime = Mid(adoDateTime(0), 10)
        Else
            MsgBox "数据库连接失败，请找系统管理员进行检查 ！", 16, cProgramName
            End
        End If
    End With
    
    SqlCommand.ActiveConnection = adoCN
    SqlCommand.CommandType = adCmdText
    Exit Function
SQLConErr:
    Select Case Err.Number
        Case -2147467259
            MsgBox "找不到指定的SQL Server服务器或者数据库不存在，请重新设置！", vbExclamation
            F_SetSystem.Show 1
        Case -2147217843
            MsgBox "指定的SQL Server数据库用户不存在或口令错误，请重新设置！", vbExclamation
            F_SetSystem.Show 1
        Case Else
            MsgBox "数据环境连接失败，请找系统管理员进行检查 ！", 16, cProgramName
    End Select
    OpenConnection
End Function

Answer 4

On Err GoTo 是可以补到这个错误的呀你用Err.Number & vbCrLf & Err.Description看一看就知道了
   on error goto ErrHandle1
ErrHandle1:
    Screen.MousePointer = vbDefault
    MsgBox "Can't Connect to SQLServer" & vbCrLf & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbExclamation, "Connect Error"