从Excel ADO连接获取值到.xlsx文件

时间:2018-04-13 16:27:19

标签: excel vba ado xlsx

我很高兴使用vba和ADO,而且我一直坚持如何在ADO中获取或返回SQL查询中的值一段时间。

我不是专业人士,所以我已经将我见过的多个例子和通过测试找到了完成大部分工作的方法。根据我的收集,我不能使用Jet连接,下面的MSDASQL连接应该可以工作。

基本上我有一个excel文件,它引用了ADO库6.1,我运行以下代码连接到另一个.xlsx文件并从特定工作表中检索数据。

工作表上的数据只是两列,一列有键,另一列有值。标题字面上是"键"和"价值观"然后在那之下有3行数据。

这是我到目前为止所得到的但是我还没有能够检索到的值(我还在这里和那里测试了位,所以请忽略任何未使用的Dims或变量,我将最终使用它们这里):

Function GetCredentialsTest() As Variant
Dim app As New Excel.Application, FileName As String, AlgoName As String, SRange As Variant, credentials As Variant, _
APISheetName As String

credentials = Array()
'ReDim Preserve credentials(UBound(credentials) + 4, UBound(credentials) + 4)
FileName = "c:\Users\" & Environ("Username") & "\AppData\Roaming\Microsoft\AddIns\Storage.xlsx"
APISheetName = "-----Credentials"

Dim sSQLQry As String
Dim ReturnArray

Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset

Dim DBPath As String, sconnect As String


DBPath = FileName

sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"

Conn.Open sconnect

sSQLSting = "SELECT * From [-----Credentials$]" 

mrs.Open sSQLSting, Conn
credentials = mrs.GetRows

'When I use the below Msg Box I do get 1:2-2:3 indicating the array is correctly sized I think    
MsgBox "1:" & UBound(credentials, 1) - LBound(credentials, 1) + 1 & "-" & "2:" & UBound(credentials, 2) - LBound(credentials, 2) + 1

'when I try to see an individual value though I get a subscript out of range error
MsgBox credentials(2, 2)
'ive also tried to copy directly to a sheet cell but i've had no luck
'Sheet1.Range("A2").CopyFromRecordset mrs

mrs.Close
Conn.Close
GetCredentialsTest = credentials

End Function

0 个答案:

没有答案