1

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

我已经编码了这个：

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价值workbook1.xlsm。

我遇到了两个问题。

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

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

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

第二个问题：我不能只获得一个单元格值。我试过只输入[A1]，rst.open但它不起作用。如何获得带有地址的唯一单元格值？用它的名字？

4

2 回答 2

3

如果您不介意，我会为您提供一些不同的尝试来获取您的数据。不同之处在于您连接数据库的方式（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
于 2013-05-31T18:34:12.793 回答
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 连接，但功能可能不那么强大。

于 2013-06-04T15:12:00.407 回答