Public adoCN As New ADODB.Connection       '定义数据库的连接存放数据和代码
Public adoCNAccess As New ADODB.Connection '定义数据库的连接存放数据和代码
Public adoCNAccess1 As New ADODB.Connection '定义数据库的连接存放数据和代码
Public adoCNtemp As New ADODB.Connection   '临时数据库
Public SqlCommand As New ADODB.Command     '定义 SQL 命令
Public RsUsers As New ADODB.Recordset
Public RsDept As New ADODB.Recordset
Public Rs_Dm_Level As New ADODB.Recordset
Dim adoDateTime As New ADODB.Recordset     '获取 NT-SERVER 时间
'***********************************************************************
'*  功能:与 SQL SERVER 数据库建立连接并取出服务器时间
'***********************************************************************
Public Function OpenConnection1() As String '打开数据库
End FunctionPublic 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'***********************************************************************
'*  功能:连接数据报表环境
'*
'***********************************************************************
Public Sub OpenDEConnection()        '连接数据环境
    On Error GoTo DEConErr
    With DE_Report.Con_report
        If .State = adStateOpen Then
            .Close
        End If
        .CursorLocation = adUseClient
        .ConnectionTimeout = 15
        .ConnectionString = "Provider=SQLOLEDB.1;Password=" & cSQLPassword & ";Persist Security Info=True;User ID=" & cSQLUserName & ";Initial Catalog=" & cDatabaseName & ";Data Source=" & cNtServerName
        .Open
    End With
    Exit Sub
DEConErr:
    Select Case Err.Number
        Case Else
            MsgBox "数据环境连接失败,请找系统管理员进行检查 !", 16, cProgramName
            End
    End Select
End SubPublic Function OpenAccess() As String
    With adoCNAccess
        If .State <> adStateOpen Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & cProgramPath & "Trade.mdb" ';password=allway"
            .ConnectionTimeout = 5
            .Open
            If .State = adStateOpen Then
                OpenAccess = "数据库连接成功"
            Else
                OpenAccess = "数据库连接失败,请按帮助进行检查 !"
                MsgBox "数据库连接失败,请找系统管理员进行检查 !", 16, cProgramName
                End
            End If
        End If
    End With
End Function