PersonID = B.PersonID
),
CTE1 AS
(SELECT ProjectID, AVG(ProjectScore) * 0.7 AS ProjectScore
FROM CTE
WHERE IsExpert <>1
GROUP BYProjectID
UNION ALL
SELECT ProjectID,AVG(ProjectScore) * 0.3 AS ProjectScore
FROM CTE
WHERE IsExpert =1
GROUP BYProjectID
) SELECTProjectID, SUM(ProjectScore) AS ProjectScore
FROM CTE1
GROUP BY ProjectID;
ELSE
SELECT ProjectID, AVG(ProjectScore) AS ProjectScore
FROM dbo.MyScore
GROUP BY ProjectID;
END;
将前面介绍的Excel中按钮strSQL的代码替换为存储过程，如下所示：
Sub 按钮1_Click()
Dim cn As New ADODB.Connection, strCn AsString, strSQL As String, rs As New ADODB.Recordset
strCn ="Provider=sqloledb;Server=46.0.187.151;Database=MyTMP;Uid=sa;Pwd=zhj11111"
cn.Open strCn
If cn.State <> adStateOpen Then
On Error Resume Next
cn.Close
Err.Clear
o = MsgBox("数据连接失败", vbOKOnly,"提示")
Exit Sub
End If
?
?
'清除Excel工作表中的数据并设置列名称
ActiveWorkbook.Worksheets("Sheet1").Cells.Select
Selection.ClearContents
Range("A1").Value = "参评项目ID"
Range("B1").Value = "平均分值"
?
'直接查询所有评选人员的平均分值
strSQL ="EXECUTE dbo.usp_GetScore"
rs.Open strSQL, cn, adOpenKeyset,adLockReadOnly
o = MsgBox("记录数：" &rs.RecordCount & "，游标位置：" &rs.CursorLocation, vbOKOnly) '提示获取到的行数
With rs
If Not (.BOF And .EOF) Then '有数据记录，则遍历记录集显示在Excel工作表中
For i = 2 To .RecordCount + 1
Cells(i, 1) = .Fields(0)
Cells(i, 2) = .Fields(1)
.MoveNext
Next
End If
End With
End Sub
执行代码，这时会发现对话框返回记录集的行数为-1，如下图所示。由于无法确定记录行数，所以也就无法写入到Excel中。
解决的方法是把记录集的CursorLocation属性指定为adUseClient，这样就可以正常运行了。参考下面的代码：
strSQL ="EXECUTE dbo.usp_GetScore"
rs.CursorLocation = adUseClient
rs.Open strSQL,cn, adOpenKeyset, adLockReadOnly
即使未指定adUseClient，虽然记录集的RecordCount返回-1，但是，记录集实际上是有数据的，我们可以不使用遍历记录集的方法，而是使用Excel的CopyFromRecordset方法把记录集直接粘贴到工作表中，参考下面的代码：
Sub 按钮1_Click()
Dim cn As New ADODB.Connection, strCn AsString, strSQL As String, rs As New ADODB.Recordset
strCn ="Provider=sqloledb;Server=46.0.187.151;Database=MyTMP;Uid=sa;Pwd=zhj11111"
cn.Open strCn
If cn.State <> adStateOpen Then
On Error Resume Next
cn.Close
Err.Clear
o = MsgBox("数据连接失败", vbOKOnly,"提示")
Exit Sub
End If
?
?
'清除Excel工作表中的数据并设置列名称
ActiveWorkbook.Worksheets("Sheet1").Cells.Select
Selection.ClearContents
Range("A1").Value = "参评项目ID"
Range("B1").Value = "平均分值"
'直接查询所有评选人员的平均分值
strSQL = "EXECUTEdbo.usp_GetScore"
rs.CursorLocation = adUseClient
rs.Open strSQL, cn, adOpenKeyset,adLockReadOnly
Range("A2").CopyFromRecordset rs ‘直接粘贴到Excel中
End Sub
?