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









