Как сделать определенный пользователь-функцию с подключением 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 

I судимого использовать это в клетке, подписав формулу

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

и посмотрите, что строка «tmp.CopyFromRecordset rst» моего кода не работает Пожалуйста, помогите решить этот вопрос. Спасибо большое

Answer 1

Если вы хотите вызвать эту функцию из любой ячейки excel, необходимо внести некоторые изменения.

первого я сделал некоторые испытания, и это, кажется, не имеет права указывать одну ячейку в SQL заявление, поэтому будет необходимо для вызова функции следующим образом:

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

где первая ячейка B4 будет тем, кого вы ищете.

второго Функция немного улучшилась с некоторыми комментариями внутри выглядит следующим образом:

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 и он работает отлично.