数据库连接出错！！！！

Question

Private Sub Command1_Click()
OpenConnection
If Err.Number = 0 Then
MsgBox "数据连接成功", vbOKOnly, "数据库连接成功"
End If
End Sub
'以上是一个窗体，窗体上有一个按钮控件，Command1,caption为测试数据库连接！这是我连接SQLServer数据库的一个模块！
Public rsNew As ADODB.Recordset
Public cnNew As ADODB.Connection
Public addFlag As Boolean
'*****************************************
'*名称：OpenConnection
'*功能：打开数据库连接
'*****************************************Public Function OpenConnection() As Boolean
Dim sMsg As String
On Error GoTo strErrHandle
Set cnNew = New ADODB.Connection
cnNew.ConnectionTimeout = 25
cnNew.Provider = "sqloledb"
'cnNew.Properties("data source").Value = "MYSERVER" '服务器名   ★★★★★
cnNew.Properties("initial catalog").Value = "gzgl" '库名
cnNew.Properties("integrated security").Value = "SSPI" '登陆类型
cnNew.Properties("user id").Value = "sa"
cnNew.Properties("password").Value = "sa"
cnNew.OpenOpenConnection = True
addFlag = True
Exit FunctionstrErrHandle:
sMsg = "数据库连接失败，请检查数据库是否存在！"
MsgBox sMsg, vbCritical + vbOKOnly, "数据库连接失败"
addFlag = False
EndEnd FunctionPublic Sub CloseConnection()
'关闭数据库
On Error Resume Next
If cnNew.State <> adStateClosed Then cnNew.Close
Set cnNew = Nothing
End Sub
'*****************************************
'*名称：GetRecordset
'*功能：连接数据库记录集
'*****************************************
Public Function GetRecordset(ByVal strSQL As String) As Boolean
Dim strMsg As String
Dim bReturn As Boolean
On Error GoTo strErrHandle
Set rsNew = New ADODB.Recordset
If addFlag = False Then bReturn = OpenConnectionWith rsNew
.ActiveConnection = cnNew
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open strSQL
End With
addFlag = True
GetRecordset = True
Exit FunctionstrErrHandle:
strMsg = "数据库生成结果出错！"
MsgBox strMsg, vbCritical + vbOKCancel, "数据库连接失败"
GetRecordset = False
EndEnd Function
Public Sub CloseRecordset()
'关闭数据集
On Error Resume Next
If rsNew.State <> adStateClosed Then rsNew.Close
Set rsNew = Nothing
End Sub问题：1、我的SQL Server服务器是MYSERVER，我想通过代码自动获得本机SQL Server服务器名，同时想实现如果我的程序在没有安装SQL Server数据库的时候，提示安装！
      2、我以上给出的代码是完全正确的，为了进行测试我把服务器名改为Server1，然后调试，程序无法响应也不报错，照理来说应该提示：数据库连接失败，请检查数据库是否存在！"的啊，改了一个当前不存在的服务器名，就程序中断，不知道各位有没有遇到过这个问题！急切地想解决这个问题！问题解决即结贴！

Answer 1

To cuizm(射天狼):
'cnNew.Properties("data source").Value = "MYSERVER" '服务器名   ★★★★★
改为'cnNew.Properties("data source").Value = "" '服务器名   ★★★★★数据库用你自己的啊！再试试啊！

Answer 2

引用Microsoft SQLDMO Object Library
OpenConnection修改如下：
Public Function OpenConnection() As Boolean
    Dim sMsg As String
    On Error GoTo strErrHandle
    Set cnNew = New ADODB.Connection
    cnNew.ConnectionTimeout = 25
    cnNew.Provider = "sqloledb"
    cnNew.Properties("data source").Value = "MYSERVER" '服务器名   ★★★★★
    cnNew.Properties("initial catalog").Value = "gzgl" '库名
    cnNew.Properties("integrated security").Value = "SSPI" '登陆类型
    cnNew.Properties("user id").Value = "sa"
    cnNew.Properties("password").Value = "sa"
    cnNew.Open
    '利用 SQL DMO Application 对象查找可用的SQL服务器
    Dim oSQLServerDMOApp As New SQLDMO.Application
    Dim namX As SQLDMO.NameList
    Dim i As Integer
    
    'ListAvailableSQLServers方法枚举服务器列表
     namX = oSQLServerDMOApp.ListAvailableSQLServers     For i = 1 To namX.Count
        
         If MYSERVER = namX.Item(i) Then
             OpenConnection = True
             addFlag = True
             Exit Function
         End If     Next    sMsg = "数据库连接失败，请检查数据库是否存在！"
    MsgBox sMsg, vbCritical + vbOKOnly, "数据库连接失败"
    addFlag = False
    Exit FunctionstrErrHandle:
    Err.Raise Err.Number, , Err.DescriptionEnd Function

Answer 3

非常感谢 busisoft(chunlin) ：
但是编译时出现如下错误：    编译错误：
     赋值号左边的函数调用必须返回变体或对象！！
    错误行：namX = oSQLServerDMOApp.ListAvailableSQLServers
    是不是缺少一个返回值啊，这个问题急待解决，再帮忙看一下吧！

Answer 4

不懂，加个SET呢
set namX = oSQLServerDMOApp.ListAvailableSQLServers

Answer 5

给一点题外的建议：既然函数返回值是Boolean型，addFlag似乎多余。另，err对象是不能跨模块的。这样好不好：Private Sub Command1_Click()
  If OpenConnection Then
     MsgBox "数据连接成功", vbOKOnly, "数据库连接成功"
  End If
End Sub