VBA ADODB-使用与数据库相同的工作簿的Excel表格选择查询 [英] VBA ADODB- Select query using the excel sheet of the same workbook as Database

问题描述

我是VBA的新手，所以请不要介意，如果问题是低级别的。我正在尝试运行一个SQL查询，其中数据必须从同一工作簿的其中一个工作表中提取。

  SQL = 从[sData $]中选择ProductNumber，其中ProductSource =& pSource& 
 
'pSource是存储产品来源的字符串
'sdata是工作簿中名为Data的工作表
 
 dataPath = ThisWorkbook.Fullname 
 
'不确定这是我将在getData函数中作为datapath发送的值
 
设置rst = getData（dataPath，SQL）
 rst.Open 
  

getData函数定义如下

 公共函数getData（路径as String，SQL作为字符串）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&;& _ 
扩展属性=Excel 8.0; HDR =是; FMT =分隔; IMEX = 1;）
 rs.ActiveConnection = cn 
 rs.Source = SQL 
设置getData = rs 
结束功能
  

现在，从数据表中获取数字后，我需要找到相应的
ProductComp任何从关系表。 9为Amul，5为雀巢等。

关系：

我不知道该怎么做。

解决方案

看下面的示例，显示如何创建ADODB连接到本工作簿从SQL查询获取ADODB记录集，从关系表中检索键值对，创建并填充字典，并从记录集中输出值，并从字典中输出相应的值：

  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 
 
'创建ADODB连接到此工作簿
设置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;; 
'从SQL查询获取ADODB记录集
设置oRs = oCn.Execute（SELECT DISTINCT ProductNumber FROM [Data $] WHERE ProductSource ='A1'）
 
' - 关系表
的值对与ThisWorkbook.Sheets（Relation）
 aKeys = Split（.Range（B1），，）
 aItems = Split（.Range B2），，）
结束
'创建和填充字典
设置oDict = CreateObject（Scripting.Dictionary）
对于i = 0到UBound （aKeys）
 oDict（Trim（aKeys（i））+ 0）= Trim（aItems（i））
下一个
 
'输出记录集中的值和相应的值从字典
 oRs.MoveFirst 
 Do Until oRs.EOF 
 dProdNum = oRs.Fields（0）.Value 
 Debug.Print dProdNum&  - & oDict（dProdNum）
 oRs.MoveNext 
循环
 
 End Sub 
  

我的输出如下：

4 - Britanica
5 - Nestle
9 - Amul

请注意，上述代码中的连接字符串显示为 .xls 文件。如果 .xlsm ，您应该使用：

  oCn.Open _ 
Provider = Microsoft.ACE.OLEDB.12.0; &安培; _ 
Data Source ='& ThisWorkbook.FullName& ; &安培; _ 
扩展属性=Excel 12.0宏; HDR =是; FMT =分隔; IMEX = 1;; 
  

I am novice in VBA so please don't mind if the question is of low level.I am trying to run a SQL query where the data has to be extracted from one of the sheets of the same workbook.

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

The getData function is defines as below

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

Now after I get the numbers from Data sheet, I need to find the corresponding ProductCompany from Relation sheet. 9 is for Amul, 5 is for Nestle and so on.

Relation:

I am not sure how to do that. The numbers corresponds to their respective Product company in order.

解决方案

Take a look at the below example showing how to create ADODB connection to this workbook, get ADODB recordset from SQL query, retrieve key - value pairs from relation sheet, create and populate a dictionary, and output the values from the recordset and the corresponding values from the dictionary:

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

The output for me is as follows:

4 - Britanica
5 - Nestle
9 - Amul

Note, connection string in the above code shown for .xls file. In case .xlsm you should use:

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

这篇关于VBA ADODB-使用与数据库相同的工作簿的Excel表格选择查询的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！