如何使用 ADO 连接进行用户定义函数

Question

请帮我在 excel vba 中创建一个用户定义的函数 例子

Function GetTheValue(wbPath, wbName, wsName, cellRef)
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim tmp As Range
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & wbPath & wbName & ";" & _
      "Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
    rst.Open "SELECT * FROM [" & wsName & "$" & cellRef & "]", cnn
    Set tmp = Range("L5")
    tmp.CopyFromRecordset rst
    MsgBox tmp.Value
    GetTheValue = tmp.Value
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Function

我尝试通过签署公式在单元格中使用它

=GetThaValue("D:\";"test.xls";"Sheet1";"B4")

并看到我的代码的字符串“tmp.CopyFromRecordset rst”不起作用 请你能帮我解决这个问题。 非常感谢

Answer 1

如果您想从任何 Excel 单元格调用此函数，则需要进行一些更改。

首先-我做了一些测试，似乎不允许在SQL语句中指向单个单元格，因此需要以这种方式调用您的函数：

=GetThaValue("D:\";"test.xls";"Sheet1";"B4:B5")

第一个单元格B4 将是您搜索的单元格。

第二-功能稍有改进，里面有一些cmets如下：

Function GetTheValue(wbPath, wbName, wsName, cellRef)
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim tmp As Range
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset

    'some changes here according to www.ConnectionStrings.Com
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
          "Data Source=" & wbPath & wbName & ";" & _
          "Extended Properties=""Excel 8.0;"""

    rst.Open "SELECT * FROM [" & wsName & "$" & cellRef & "]", cnn

    'Set tmp = Range("L5")      'NOT needed here
    'tmp.CopyFromRecordset rst   'NOT allowed if function is called from Excel
    'MsgBox tmp.Value           'NOT necessary in this function

    'NEW- in this way we get value of your cell and pass it to excel
    GetTheValue = rst.Fields(0).Value

    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Function

我可以确认它已针对 Excel 2010 进行了测试，并且工作正常。