在这个问题之后:get value/charts in another workbooks without opening it
我编码了这个:
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
目前我的目标是获取cell A1
sheet 1
的{{1}}中的值。
我遇到了两个问题。
当workbook1.xlsm
未打开时,我得到了
workbook1
这很烦人,因为我想在不打开工作簿的情况下工作。当工作簿打开时,它运行良好。
第二个问题:我无法设法只获得单个单元格值。我试图仅在Run time error '-214767259 (80004005)': Automation error Unspecified Error on the line oConn.Open "C:\Workbook1.xlsm`
中输入[A1]
,但它不起作用。如何通过其地址获得唯一的单元格值?用它的名字?
答案 0 :(得分:2)
如果您不介意我会为您提供一些不同的尝试来获取您的数据。不同之处在于您与数据库连接的方式(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
答案 1 :(得分:1)
我的解决方案:
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连接,但可能不那么强大。