Excel使用ADO调用SQL Server存储过程

测试环境：SQL Server 2014，Excel 2013

Excel示例文件下载：http://download.csdn.net/detail/zhanghongju/8533555

前期在做一个现场投票的小软件，准备使用Excel实现，工作簿中包含有两个工作表，各包含一个命令按钮，分别用于提交和查看投票结果。

问题出在查看投票按钮上，起初只是使用SELECT语句查询，一切正常；后期对于投票结果需要进行一些权重的计算，过程比较复杂，便想到把计算过程放在SQL Server端，使用存储过程实现。但是，在调用存储过程的过程中却遇到了问题，一直无法返回记录集。最后发现问题出现在记录集的CursorLocation属性设置上，下面便把此问题的过程和解决方案提供如下，以免发生类似问题。

一、使用CursorLocation属性设置游标的区别

CursorLocation属性包含两个属性值：adUseClient（常量值为3）和adUseServer（常量值为2）。adUseClient表示使用由本地游标库提供的客户端游标，adUseServer是默认值，表示使用数据提供者的或驱动程序提供的游标。

adUseClient游标服务的功能通常更加强大一些，许多功能可能是驱动程序提供的游标无法提供的。但是，adUseServer游标具有高度的敏感性，可以看到其他用户对数据源所作的更改，对于一些多用户操作，该特性是具有优势的。也正是因为此特性，会导致记录集行数的具有不确定性，因此某些情况下是无法使用RecordCount属性获取记录集的行数，也无法使用EOF和BOF判断是否到达记录集的尾部和头部。

二、在SQL Server中创建示例数据

下面的语句用于在SQL Server中创建两个表。dbo.MyScore用于存储评选人员ID、项目ID和评选分数，dbo.MyPerson用于存储评选人员ID和评选人员是否为专家的标志，标志为1，表示此评选人员为专家。

IF OBJECT_ID(‘dbo.MyScore‘) IS NOT NULL

   DROP TABLE dbo.MyScore;

IF OBJECT_ID(‘dbo.MyPerson‘) IS NOT NULL

   DROP TABLE dbo.MyPerson;

GO

CREATE TABLE dbo.MyScore(PersonID int, ProjectID int, ProjectScore int);

CREATE TABLE dbo.MyPerson(PersonID int, IsExpert int);

INSERT INTO dbo.MyScore VALUES

   (1, 1001, 90),

   (1, 1002, 80),

   (1, 1003, 95),

   (2, 1001, 85),

   (2, 1002, 85),

   (2, 1003, 90),

   (3, 1001, 100),

   (3, 1002, 90),

   (3, 1003, 95);

INSERT INTO dbo.MyPerson VALUES

   (1, 0),

   (2, 0),

   (3, 1);  --3是专家评测人员

三、Excel中的查询方法

1．执行SELECT查询

打开Excel，在Sheet1中插入一个命令按钮，并为其指定Click方法，代码如下：

Sub 按钮1_Click()

    Dim cn As New ADODB.Connection, strCn AsString, strSQL As String, rs As New ADODB.Recordset

    strCn ="Provider=sqloledb;Server=192.0.168.1;Database=MyTMP;Uid=sa;Pwd=111111"

    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 = "SELECTProjectID,AVG(ProjectScore) AS ProjectScore FROM dbo.MyScore GROUP BYProjectID"

    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

上面的代码中使用MsgBox函数来提示获取到的记录集行数，有数据记录的话，则遍历记录集，将数据写入到Excel工作表中。上面的代码没有为记录集指定CursorLocation属性，则使用默认值adUseServer，执行时可看到弹出对话框中显示的记录数和游标位置，如下图所示。

当然，为了确保ADO对象的正常引用，应当在项目中添加对Microsoft ActiveXData Objects支持库的引用，如下图所示。

2．执行存储过程

首先在SQL Server中创建一个名为dbo.usp_GetScore的存储过程，该过程用于判断评选时是否有专家参与，如果有专家参与，则按照普通人员70%、专家人员30%的权重计算项目的分值；如果没有，则直接计算项目的平均分值。

CREATE PROCEDURE  dbo.usp_GetScore

AS

BEGIN

   DECLARE@IsExpert AS int;

   SELECT TOP 1 @IsExpert = B.IsExpert

   FROM dbo.MyScore A

      INNER JOIN dbo.MyPerson B

      ON A.PersonID = B.PersonID

   WHERE B.IsExpert = 1;

   /*有专家投票的情况下，专家比重为30%，其他人员为70%；

   否则，则直接取所有人的平均值*/  

   IF @IsExpertIS NOT NULL 

      WITH CTE AS

         (SELECT A.ProjectID,A.ProjectScore,B.IsExpert

          FROMdbo.MyScore A

             INNERJOIN dbo.MyPersonB

                ONA.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