VBA - 从电子表格的内容创建ADODB.Recordset [英] VBA - Create ADODB.Recordset from the contents of a spreadsheet

问题描述

我正在处理查询SQL数据库的Excel应用程序。查询可能需要很长时间才能运行（20-40分钟）。如果我错过编码的东西，可能需要很长时间才能出现错误或达到断点。我可以将结果保存到表格中，这是当我正在处理记录集时，事情可能会爆炸。

当我正在调试以跳过查询数据库（第一次）后，有没有办法将数据加载到ADODB.Recordset？

我会使用这样的东西吗？

在MS-Access VBA中查询Excel工作表（使用ADODB记录集）

解决方案

我不得不安装MDAC来获取msado15.dll，一旦我有了，就从（在Win7 64bit上）添加一个引用：

C：\程序文件（x86）\Common Files\System\ado\msado15.dll

然后我创建了一个通过传入当前活动工作簿中存在的工作表名称来返回ADODB.Recordset对象的功能。这里是任何其他人的代码，如果他们需要它，包括一个Test（）Sub，看看它是否有效：

 公共功能RecordSetFromSheet （sheetName As String）
 
 Dim rst As New ADODB.Recordset 
 Dim cnx As New ADODB.Connection 
 Dim cmd As New ADODB.Command 
 
 '设置连接
'[HDR =是]表示字段名称在第一行
与cnx 
 .Provider =Microsoft.Jet.OLEDB.4.0
。 ConnectionString =Data Source ='& ThisWorkbook.FullName& ;& 扩展属性='Excel 8.0; HDR =是; IMEX = 1'
 .Open 
结束
 
'设置命令
设置cmd.ActiveConnection = cnx 
 cmd.CommandType = adCmdText 
 cmd.CommandText =SELECT * FROM [& sheetName& $
 rst.CursorLocation = adUseClient 
 rst.CursorType = adOpenDynamic 
 rst.LockType = adLockOptimistic 
 
'打开连接
 rst.Open cmd 
 
'断开记录集
设置rst.ActiveConnection =没有
 
'清理
如果CBool​​（cmd.State和adStateOpen）= True然后
设置cmd = Nothing 
如果
 
如果CBool​​（cnx.State和adStateOpen）= True则cnx.Close 
设置cnx = Nothing 
 
'返回记录集对象
设置RecordSetFromSheet = rst 
 
结束函数
 
公共子测试（）
 
 Dim rstData作为ADODB.Recordset 
设置rstData = RecordSetFromSheet（Sheet1）
 
表单（Sheet2）。范围（A1）。CopyFromRecordset rstData 
 
结束Sub 
  

Sheet1数据：
Field1 Field2 Field3
Red A 1
蓝色B 2
绿色C 3

应该复制到S heet2：
红色A 1
蓝色B 2
绿色C 3

这样可以节省大量的查询时间SQL每次我想进行更改并测试出来...

- Robert

I am working on an Excel application that queries a SQL database. The queries can take a long time to run (20-40 min). If I've miss-coded something it can take a long time to error or reach a break point. I can save the results to a sheet fine, it's when I am working with the record sets that things can blow up.

Is there a way to load the data into a ADODB.Recordset when I'm debugging to skip querying the database (after the first time)?

Would I use something like this?

Query Excel worksheet in MS-Access VBA (using ADODB recordset)

解决方案

I had to install the MDAC to get the msado15.dll and once I had it I added a reference to it from (on Win7 64bit):

C:\Program Files (x86)\Common Files\System\ado\msado15.dll

Then I created a function to return an ADODB.Recordset object by passing in a sheet name that exists in the currently active workbook. Here's the code for any others if they need it, including a Test() Sub to see if it works:

Public Function RecordSetFromSheet(sheetName As String)

Dim rst As New ADODB.Recordset
Dim cnx As New ADODB.Connection
Dim cmd As New ADODB.Command

    'setup the connection
    '[HDR=Yes] means the Field names are in the first row
    With cnx
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
        .Open
    End With

    'setup the command
    Set cmd.ActiveConnection = cnx
    cmd.CommandType = adCmdText
    cmd.CommandText = "SELECT * FROM [" & sheetName & "$]"
    rst.CursorLocation = adUseClient
    rst.CursorType = adOpenDynamic
    rst.LockType = adLockOptimistic

    'open the connection
    rst.Open cmd

    'disconnect the recordset
    Set rst.ActiveConnection = Nothing

    'cleanup
    If CBool(cmd.State And adStateOpen) = True Then
        Set cmd = Nothing
    End If

    If CBool(cnx.State And adStateOpen) = True Then cnx.Close
    Set cnx = Nothing

    '"return" the recordset object
    Set RecordSetFromSheet = rst

End Function

Public Sub Test()

Dim rstData As ADODB.Recordset
Set rstData = RecordSetFromSheet("Sheet1")

Sheets("Sheet2").Range("A1").CopyFromRecordset rstData

End Sub

The Sheet1 data: Field1 Field2 Field3 Red A 1 Blue B 2 Green C 3

What should be copied to Sheet2: Red A 1 Blue B 2 Green C 3

This is saving me a HUGE amount of time from querying against SQL every time I want to make a change and test it out...

--Robert

这篇关于VBA - 从电子表格的内容创建ADODB.Recordset的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！