VB与数据库连接的问题
在设计状态下点击“frmSalesQuery(frmSalesQuery.frm)”会出现“[DBNETLIB][Connectionopen(Connece()).]SQL Server不存在的或拒绝访问”的警告语句,再点确定就会显示出如下图的窗体,这个是怎么回事,谁能帮我改改啊??谢谢了
程序的代码如下:
程序代码:
Private Sub cmdExit_Click() Unload Me End Sub Private Sub cmdQuery_Click() On Error GoTo ErrHandler Dim strCmand As String '姓名为空查询全部员工的销售情况 If Trim(cboUserName.Text) = "" Then If chkTime.Value = vbChecked Then If DateDiff("d", dtpStartDate.Value, dtpEndDate.Value) < 0 Then MsgBox "结束时间必须大于或等于开始时间!", vbExclamation dtpEndDate.SetFocus Exit Sub Else strCmand = "SELECT Users.UserName,Products.ProductName," & _ "Products.UnitPrice,Sales.SaleQuantiy,Sales.SaleDate " & _ "FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _ "INNER JOIN Users ON Sales.UserID = Users.UserID " & _ "WHERE Sales.SaleDate >= '" & dtpStartDate.Value & _ "' AND Sales.SaleDate<= '" & dtpEndDate.Value & "'" End If Else strCmand = "SELECT Users.UserName, Products.ProductName," & _ "Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _ "FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _ "INNER JOIN Users ON Sales.UserID = Users.UserID " End If Else '姓名不为空查询查询当前员工的销售情况 If chkTime.Value = vbChecked Then If DateDiff("d", dtpStartDate.Value, dtpEndDate.Value) < 0 Then MsgBox "结束时间必须大于或等于开始时间!", vbExclamation dtpEndDate.SetFocus Exit Sub Else strCmand = "SELECT Users.UserName, Products.ProductName," & _ "Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _ "FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _ "INNER JOIN Users ON Sales.UserID = Users.UserID " & _ "WHERE Sales.SaleDate >= '" & dtpStartDate.Value & _ "' AND Sales.SaleDate<= '" & dtpEndDate.Value & _ "' and Users.UserName = '" & cboUserName.Text & "'" End If Else strCmand = "SELECT Users.UserName, Products.ProductName," & _ "Products.UnitPrice , Sales.SaleQuantiy, Sales.SaleDate " & _ "FROM Products INNER JOIN Sales ON Products.ProductID = Sales.ProductID " & _ "INNER JOIN Users ON Sales.UserID = Users.UserID " & _ "WHERE Users.UserName = '" & cboUserName.Text & "'" End If End If Adodc2.RecordSource = strCmand Adodc2.Refresh Exit Sub ErrHandler: MsgBox "错误号:" & Err.Number & " 错误信息:" & Err.Description End Sub Private Sub DataGrid2_Click() End Sub Private Sub Form_Load() Dim sql As String Dim rs As ADODB.Recordset '设置窗体位置 ChangeFormPos frmMain, frmSalesQuery sql = "select UserName from Users" Set rs = ExeSQL(sql) If rs.EOF = True Then MsgBox "当前数据库中没有信息!", vbExclamation Else rs.MoveFirst Do Until rs.EOF strUserName = rs!UserName cboUserName.AddItem strUserName rs.MoveNext Loop rs.Close End If dtpStartDate.Value = Now dtpEndDate.Value = Now End Sub