sql server ado 是否需要关闭_自定义SQL函数

大家好，我是知了。 翻了翻之前的文章，发现上一篇关于 SQL 的，已经是半年前的事了。 调用 ADO SQL 需要一大堆的固定套路，最近看到了一个关于自定义 SQL 函数，可以将查询结果放进一个二维数组，并且省掉了一些繁琐。 我把它稍微简化了一下，方便使用。 —  — 比如下边的源数据表格：

函数的使用方法：

函 数 名 ：   GSTA 函数功能：  获得指定SQL的查询结果 返 回 值 ：  返回一个二维数组 参  数  1：   StrSQL  字符类型  SQL查询语句 参  数  2：   Biaoti  可选参数   是否输出标题，默认带有标题 使用方法：   = GSTA(StrSQL,true) —  —

VBA的使用方法：

Sub test()Dim StrSQL$, SQLARR '定义变量
    StrSQL = "select * from [源数据$]" '编写SQL语句
    SQLARR = GSTA(StrSQL, True) '调用函数
    Sheets("结果").Range("A1").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR '输出结果End Sub

—  —

自定义函数代码如下：

Public Function GSTA(ByVal StrSQL As String, Optional Biaoti As Boolean = True) As Variant()'On Error Resume Next    ' 改变错误处理的方式。Dim CN, RSDim arr()Dim I, ICOL As Long
    Str_coon = "HDR=yes';Data Source=" & ThisWorkbook.FullName'  如果链接: ACCESS Exce 或者WPSIf InStr(UCase(Application.Path), "WPS") > 0 Then' 如果是WPS中使用,  必须是4.0版本的If InStr(UCase(Str_coon), "PROVIDER=") = 0 Then' 如果是简化的链接字符  就补全
                Str_coon = "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties='Excel 8.0;" & Str_coonEnd IfElseIf InStr(UCase(Str_coon), "PROVIDER=") = 0 Then' 如果是简化的链接字符  就补全If Val(Application.Version * 1) 12 Then' 2003及以下版本的  使用4.0版本引擎
                    Str_coon = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;" & Str_coonElse' 2007及以上版本的  使用12.0版本引擎
                    Str_coon = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;" & Str_coonEnd IfEnd IfEnd IfErr.ClearSet CN = CreateObject("Adodb.Connection") '//新建一个ADO连接Set RS = CreateObject("adodb.recordset")
    CN.CursorLocation = 3
    CN.Open Str_coon
    RS.Open StrSQL, CN, 1, 3' 如果不要标题，可以：arr = RS.GetRows，代码比较省，但是速度一般If RS.RecordCount > 0 Then '//如果找到数据If Biaoti = True ThenReDim arr(0 To RS.RecordCount, 0 To RS.Fields.Count - 1)For ICOL = 0 To RS.Fields.Count - 1  '//导入标题
                arr(0, ICOL) = RS.Fields(ICOL).NameNextFor I = 0 To RS.RecordCount - 1  '//导入数据For ICOL = 0 To RS.Fields.Count - 1
                    arr(I + 1, ICOL) = RS.Fields(ICOL).ValueNext ICOL
                RS.MoveNextNextElseReDim arr(0 To RS.RecordCount - 1, 0 To RS.Fields.Count - 1)For I = 0 To RS.RecordCount - 1  '//导入数据For ICOL = 0 To RS.Fields.Count - 1
                    arr(I, ICOL) = RS.Fields(ICOL).ValueNext ICOL
                RS.MoveNextNextEnd IfElse '//如果没有找到数据If Biaoti = True ThenReDim arr(0 To 0, 0 To RS.Fields.Count - 1)For ICOL = 0 To RS.Fields.Count - 1  '//导入标题
                arr(0, ICOL) = RS.Fields(ICOL).NameNextElseReDim arr(0, 0)
            arr(0, 0) = ""End IfEnd IfIf Err.Number <> 0 ThenMsgBox "Error！" & Err.DescriptionReDim arr(0, 0)
        arr(0, 0) = "Error"
        GSTA = arr(0, 0)End If
    GSTA = arr
    RS.Close
    CN.Close  '//关闭ADO连接Set RS = NothingSet CN = Nothing  '//释放内存End Function

-END-