读取工作簿而不用ADO打开它

在这个问题之后： 在其他工作簿中获取价值/图表而不打开它

我已经编码这个：

Sub test() Dim oConn As New ADODB.Connection Dim rst As New ADODB.Recordset oConn.Provider = "Microsoft.Jet.OLEDB.4.0" oConn.Properties("Extended Properties").Value = "Excel 8.0" oConn.Open "C:\Workbook1.xlsm" rst.Open "SELECT * FROM [A1:A2];", oConn, adOpenStatic rst.MoveFirst MsgBox rst.Fields(0) rst.Close oConn.Close End Sub 

目前我的目标是获取workbook1.xlsm sheet 1的cell A1中的值。

我遇到了两个问题。

当workbook1没有打开时，我得到了一个

 Run time error '-214767259 (80004005)': Automation error Unspecified Error on the line oConn.Open "C:\Workbook1.xlsm` 

这很烦人，因为我想在不打开工作簿的情况下工作。 它在工作簿打开时工作良好。

第二个问题：我不能设法得到一个单一的单元格值。 我试图在rst.open只input[A1] ，但是它不起作用。 我怎样才能得到一个独特的细胞价值与地址？ 用它的名字？

Answer 1

如果你不介意我会提供给你一些不同的尝试来获取你的数据。 不同之处在于你连接数据库的方式（excel表格）。 但是，您可能会在代码中包含一些重要的元素。 所以，检查下面的代码中的评论。

 Sub Closed_excel_workbook() Dim myConnection As String Dim myRecordset As ADODB.Recordset Dim mySQL As String 'connection string parameters 'CHANGE PATH TO YOUR CLOSED WORKBOOK myConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ThisWorkbook.Path & "\Dane\BazaDanych.xlsx;" & _ "Extended Properties=Excel 12.0" 'here is important, YOU CAN'T MISS SHEET NAME mySQL = "SELECT * FROM [ARKUSZ1$a1:a2]" 'different way of getting data from excel sheet Set myRecordset = New ADODB.Recordset myRecordset.Open mySQL, myConnection, adOpenUnspecified, adLockUnspecified 'let's clear sheet before pasting data 'REMOVE IF NOT NEEDED ActiveSheet.Cells.Clear 'HERE WE PASTING DATA WE HAVE RETRIEVED ActiveSheet.Range("A2").CopyFromRecordset myRecordset 'OPTIONAL, IF REQUIRED YOU CAN ADD COLUMNS NAMES Dim cell As Range, i! With ActiveSheet.Range("A1").CurrentRegion For i = 0 To myRecordset.Fields.Count - 1 .Cells(1, i + 1).Value = myRecordset.Fields(i).Name Next i .EntireColumn.AutoFit End With End Sub 

Answer 2

我的解决scheme

 Function GetValue() Path = "C:\Path\" File = "Doc.xlsm" Sheet = "Sheet_name" Ref = "D4" 'Retrieves a value from a closed workbook Dim Arg As String 'Make sure the file exists If Right(Path, 1) <> "\" Then Path = Path & "\" If Dir(Path & File) = "" Then GetValue = "File not Found" Exit Function End If 'Create the argument Arg = "'" & Path & "[" & File & "]" & CStr(Sheet) & "'!" & Range(Ref).Range("A1").Address(, , xlR1C1) 'Check the value MsgBox Arg 'Execute XML GetValue = ExecuteExcel4Macro(Arg) End Function 

它具有不使用复杂的adodb连接的优点，但可能不那么强大。