激活关闭的工作簿

Question

我正在使用下面的函数从其他工作簿中提取数据。

Function GetValue(path, file, sheet, ref)

    'Retrieves a value from a closed workbook
    Dim myArg 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
    myArg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
    
    'Execute an XLM macro
    GetValue = ExecuteExcel4Macro(myArg)

End Function

我这样调用这个函数：

Sub TestGetValue()
    Dim p As String, f As String
    Dim s As String, a As String
    p = "C:\Users\schaudha\Desktop\FIT transition\test simulation results"
    f = "all cancer rate.xml"
    s = "CONTENTS"
    a = "A1"
    MsgBox GetValue(p, f, s, a)
End Sub

此功能似乎仅在工作簿处于活动状态时才有效。我的意思是，如果我打开需要从中获取数据的 Excel 文件，然后运行我的子程序，它可以工作，但如果它关闭，它就不起作用。我也希望它在工作簿关闭时工作。我猜我需要在使用ExecuteExcel4Macro(myArg) 之前以某种方式激活工作簿。我怎么做？我计划使用这个函数从大约一百个工作簿中从数千个单元格中提取数据，所以我想让这段代码尽可能高效。

Answer 1

我认为您正在寻找的是（从您的代码修改）：

If Dir(path & file) = "" Then
    GetValue = "File Not Found"
    Exit Function
else
    CurrBook = Workbooks.Open Path & File
End If
'''Code here
CurrBook.Close

这将打开文件（如果找到），您将能够从中提取数据。我希望这会有所帮助！

Answer 2

这行得通

Function GetValue(path, file, sheet, ref)

'Retrieves a value from a closed workbook
Dim myArg As String

Dim CurrBook As Workbook

'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

Application.Workbooks.Open (path & file)

'Create the argument
myArg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)

'Execute an XLM macro
GetValue = ExecuteExcel4Macro(myArg)

Application.Workbooks(file).Close (False)

End Function

Answer 3

如果您要打开根本不需要ExecuteExcel4Macro 的工作簿：

Function GetValue(path, file, sheet, ref)

    Dim CurrBook As Workbook
    
    '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
    
    Set CurrBook = Application.Workbooks.Open(path & file)
    
    On Error Resume Next
    GetValue = CurrBook.Sheets(sheet).Range(ref).Value
    
    CurrBook.Close savechanges:=False

End Function