vba 无需使用 ADO 打开即可阅读工作簿
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16859255/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Reading a workbooks without opening it with ADO
提问by lcrmorin
After this question: get value/charts in another workbooks without opening it
在这个问题之后：在另一个工作簿中获取值/图表而不打开它
I have coded this:
我已经编码了这个：
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
For the moment my goal is to get the value in the cell A1of the sheet 1of workbook1.xlsm.
目前，我的目标是获取cell A1of 的sheet 1值workbook1.xlsm。
I've encountered two problems.
我遇到了两个问题。
When the workbook1is not opened I got a
当workbook1未打开时，我得到了一个
Run time error '-214767259 (80004005)': Automation error Unspecified Error on the line oConn.Open "C:\Workbook1.xlsm`
This is annoying because I want to work without opening the workbooks. It works well when the workbook is open.
这很烦人，因为我想在不打开工作簿的情况下工作。当工作簿打开时，它运行良好。
Second problem: I can't manage to only get a single cell value. I've tried to input only [A1]in rst.openbut it doesn't work. How can I get a unique cell value with its address ? with its name ?
第二个问题：我无法只获得一个单元格值。我试着输入唯一[A1]的rst.open，但它不工作。如何通过其地址获得唯一的单元格值？用它的名字？
回答by Kazimierz Jawor
If you don't mind I'll provide you a bit different attempt to get your data. The difference is the way you connect with you database (excel sheet). However, you could possibly incorporate some important elements into your code. So, check comments inside the code below.
如果您不介意，我将为您提供一些不同的尝试来获取您的数据。不同之处在于您与数据库（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
回答by lcrmorin
My solution:
我的解决方案：
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
It has the advantage of not using complex adodb connection, but may be less powerfull.
它的优点是不使用复杂的 adodb 连接，但可能不那么强大。
