VBA ADODB- Выберите запрос, используя лист Excel той же книги, что и база данных

Question

Я новичок в VBA, поэтому, пожалуйста, не возражайте, если вопрос имеет низкий уровень. Я пытаюсь запустить SQL-запрос, где данные должны извлекаться из одного из листов одной и той же книги.

SQL = "Select ProductNumber from [sData$] where ProductSource = " & pSource & " 

'pSource is a string that stores Product Source 
'sdata is a sheet named as Data in the workbook 

dataPath = ThisWorkbook.Fullname 

'Not sure if this is the value I shall send as datapath in getData function 

Set rst = getData(dataPath,SQL) 
rst.Open 

Функция GetData является определение, как показано ниже

Public funtion getData(path as String, SQL as string) as ADODB.Recordset 
Dim rs as ADODB.Recordset 
Set cn = New ADODB.Connection 
Set rs = New ADODB.Recordset 
cn.Open ("Provider= Microsoft.Jet.OLEDB.4.0;" & _ 
      "DataSource= " & path & ";"&_ 
      "Extended Properties=""Excel 8.0;HDR=Yes;FMT=Delimited;IMEX=1;""") 
rs.ActiveConnection =cn 
rs.Source= SQL 
Set getData =rs 
End Function 

Теперь после того, как я получаю цифры от листа данных, мне нужно найти соответствующий ProductCompany из Relation листа. 9 для Амула, 5 для Нестле и т. Д.

отношений:

Я не уверен, как это сделать. Номера соответствуют их соответствующей Продуктовой компании в порядке.

Answer 1

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

Option Explicit 

Sub Test() 

    Dim oCn As Object 
    Dim oRs As Object 
    Dim aKeys 
    Dim aItems 
    Dim i As Long 
    Dim oDict As Object 
    Dim dProdNum 

    ' create ADODB connection to this workbook 
    Set oCn = CreateObject("ADODB.Connection") 
    oCn.Open _ 
     "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
     "DataSource='" & ThisWorkbook.FullName & "';" & _ 
     "Extended Properties=""Excel 8.0;HDR=Yes;FMT=Delimited;IMEX=1;"";" 
    ' get ADODB recordset from SQL query 
    Set oRs = oCn.Execute("SELECT DISTINCT ProductNumber FROM [Data$] WHERE ProductSource = 'A1'") 

    ' retrieve key - value pairs from relation sheet 
    With ThisWorkbook.Sheets("Relation") 
     aKeys = Split(.Range("B1"), ",") 
     aItems = Split(.Range("B2"), ",") 
    End With 
    ' create and populate a dictionary 
    Set oDict = CreateObject("Scripting.Dictionary") 
    For i = 0 To UBound(aKeys) 
     oDict(Trim(aKeys(i)) + 0) = Trim(aItems(i)) 
    Next 

    ' output the values from the recordset and the corresponding values from the dictionary 
    oRs.MoveFirst 
    Do Until oRs.EOF 
     dProdNum = oRs.Fields(0).Value 
     Debug.Print dProdNum & " - " & oDict(dProdNum) 
     oRs.MoveNext 
    Loop 

End Sub 

выходной сигнал для меня выглядит следующим образом:

4 - Британика
5 - Nestle
9 - Amul

Примечание. Строка подключения приведенного выше кода приведена для .xls. В случае .xlsm вы должны:

oCn.Open _ 
     "Provider=Microsoft.ACE.OLEDB.12.0;" & _ 
     "Data Source='" & ThisWorkbook.FullName & "';" & _ 
     "Extended Properties=""Excel 12.0 Macro;HDR=Yes;FMT=Delimited;IMEX=1;"";"