I am attempting to use the code
Private Function GetValue(path, file, sheet, ref)
' 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 & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
But receive #VALUE! when used as shown below:
Target ='C:\Temp[pulltest.xlsx]Sheet1'!$A$1
Parameters C:\Temp\
pulltest.xlsx
Sheet1
A1
Function =getvalue(B3,B4,B5,B6)
I'm using Excel2010 in Windows 7.
Grateful for any help
Your problem is that the GetValue function cannot be called from a worksheet cell.
So the following works:
Option Explicit
Sub GetVal()
Dim path As String, file As String, sheet As String, ref As String
path = [a7]
file = [a8]
sheet = [a9]
ref = [a10]
[a11] = GetValue(path, file, sheet, ref)
End Sub
Private Function GetValue(path, file, sheet, ref)
'Retrieves a value from a closed workbook
Dim Arg
'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)
GetValue = ExecuteExcel4Macro(Arg)
End Function
If the link is still active, you may refer to
Excel Tips from John Walkenbach: A VBA Function To Get A Value From A Closed File which includes the caveat "Note: You cannot use this function in a worksheet formula."
Related
I would like to use my function in new workbook, the function is using datas from an old Workbook, where was written.
My function in new workbook is working correctly only, if the old workbook is open too. Otherwise result is #Value.
My code is:
Function findfix(EAN,year, As Variant)
Set wb = Workbooks.Open("H:\dokumenty\NPU\NPUfix.xlsm")
ThisWorkbook.Activate
rowPos = findEAN(EAN)
c = Workbooks("NPUfix").Sheets("EAN").Cells(rowPos, 18).Value
.
.
.
Simply copy the function and related code into a new module, in the new workbook
Then just change ("H:\dokumenty\NPU\NPUfix.xlsm") to your new location.
Private Function GetValue(path, file, sheet, ref)
' 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 & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Then to get the value required
Sub TestGetValue()
p = "c:\XLFiles\Budget"
f = "Budget.xls"
s = "Sheet1"
a = "A1"
MsgBox GetValue(p, f, s, a)
End Sub
I have 2 spreadsheets, EG. test1.xlxs and test2.xlsm
test1 has the following data on sheet 1 cell B6: testdata
test2 has some vba code I want to disable if test1 is not present or has the wrong information in it, as such, I need to use an environmental variable in the VBA IF statement that that I don't have to edit the code or re link the sheets every time I move them to a new pc
The problem I have is, when I use the environmental variable The If statement tests against the string and not the cell value EG "=C:\users\username\documents[test.xlxs]Sheet1'!$B$6" instead of testdata
This is the code I currently have in test2:
Sub Check_Key()
Dim Key As String
Key = "='" & Environ("USERPROFILE") & "\Documents\[test.xlxs]Sheet1'!$B$6"
If Key = Sheet1.Range("D8") = True Then
Sheet1.Range("D9") = "Valid"
Else
Sheet1.Range("D9") = "Invalid"
End If
End Sub
is there any way to make it work?
I would prefer to have the VBA script do the verification rather than an if statement in a cell on the workbook
Requirements:
User should not be able to see data in test1 (spreadsheet should stay closed)
Data from test1 needs to be verified via VBA IF statement
test2 should be able to be anywhere on pc while test1 should be in my documents
Here is a link to the Spreadsheets, it includes the Licence file the test sheet and a key generator
Documents
The following code copies the value in cell B6 from the closed workbook.
Sub test()
'variables
Dim key As Variant, FolderName As String, wbName As String
FolderName = Environ("USERPROFILE") & "\Documents"
wbName = Dir(FolderName & "\" & "test.xlsx") 'Workbook name
key = GetInfoFromClosedFile(FolderName, wbName, "Sheet1", "B6")
End Sub
'Returns value in cell CREDIT: http://erlandsendata.no/?p=2106
Private Function GetInfoFromClosedFile(ByVal wbPath As String, wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = vbNullString
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & wbName) = vbNullString Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
'On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
If the test1 is already open in the same excel instance :
key = workbooks("test1.xlsm").worksheets("sheet1").range("B6")
If he is not
set wbk = Workbooks.open (Environ("USERPROFILE") & "\Documents\test.xlsx")
key = wbk.worksheets("sheet1").range("B6")
' other code
wbk.close false
I was looking a post at this link: http://spreadsheetpage.com/index.php/site/tip/a_vba_function_to_get_a_value_from_a_closed_file/
The function is
Private Function GetValue(path, file, sheet, ref)
' 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 & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
and to get a value,
Sub TestGetValue()
p = "c:\XLFiles\Budget"
f = "Budget.xls"
s = "Sheet1"
a = "A1"
MsgBox GetValue(p, f, s, a)
End Sub
and to loop
Sub TestGetValue2()
p = "c:\XLFiles\Budget"
f = "Budget.xls"
s = "Sheet1"
Application.ScreenUpdating = False
For r = 1 To 100
For c = 1 To 12
a = Cells(r, c).Address
Cells(r, c) = GetValue(p, f, s, a)
Next c
Next r
Application.ScreenUpdating = True
End Sub
I think it's very well written. However, I met two problems with it:
If the source cell in closed file is blank ("" in VBA), I would got 0 in getvalue.
I wonder how I can pass 0 to 0 and pass "" to ""?
Is there a bug for ExecuteExcel4Macro?
Suppose the source file has different extensions: xls, xlsx, xlsm, or xlsb,...
How can I get a dynamic path?
I tried to eliminate file extension in the path and use
arg = "'" & path & "[" & file & ".xl?]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
However, it didn't work in ExecuteExcel4Macro.
This is normal Excel behaviour. If you put a formula in a cell A1
=B1
then A1 will also show a 0
You can get a value with this code:
Public Function GetValue(sFileName As String, sSheetName As String, sAddress As String) As Variant
Dim oSheet As Worksheet
Application.ScreenUpdating = False
With Workbooks.Add(sFileName)
GetValue = .Sheets(sSheetName).Range(sAddress).Value
.Close
End With
Application.ScreenUpdating = True
End Function
I am using the function below to extract data from other workbooks.
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
I am calling this function like this:
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
This function seems to work only when the workbook is active. I mean, if I open the Excel file that I need data from and then run my subroutine, it works, but if it is closed, it doesn't work. I would also like it work when the workbook is closed. I am guessing I need to activate the workbook somehow before I use ExecuteExcel4Macro(myArg). How do I do that? I plan on using this function to extract data from thousands to cells from about a hundred workbooks, so I want to make this code as efficient as possible.
I think what you're looking for is (modified from your code):
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
else
CurrBook = Workbooks.Open Path & File
End If
'''Code here
CurrBook.Close
This will open the file, if it's found, and you'll be able to extract the data from it. I hope this helps!
This works
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
If you're going to open the workbook you don't need ExecuteExcel4Macro at all:
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
I found this bit of code and thought it might be good to use if I just need to pull one value from a closed sheet.
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
When I run this code I get a value for strinfocell of
'C:\Users\my.name\Desktop[QOS DGL stuff.xlsx]Sheet1'!R3C3
But when I run the code a dialogue pops up, showing desktop files with "QOS DGL suff" showing.
What's causing this, why is it not just pulling back the data as expected?
I know the path and file name are right, because if I copy them from the debug output and paste them in to start>>run then the correct sheet opens.
I know that Sheet1 (named: ACL), does have a value in cells(3,3)
It depends on how you use it. The open file dialog box is being showed to you because the "strPath" doesn't have a "" in the end ;)
Try this code.
Option Explicit
Sub Sample()
Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String
'wbPath = "C:\Documents and Settings\Siddharth Rout\Desktop\"
wbPath = "C:\Users\my.name\Desktop\"
wbName = "QOS DGL stuff.xls"
wsName = "ACL"
cellRef = "C3"
Ret = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, -4150)
MsgBox ExecuteExcel4Macro(Ret)
End Sub
Similar application, but no hard coded paths as in the examples above. This function copies the value from another closed workbook, similar to the =INDIRECT() function, but not as sophisticated. This only returns the value...not a reference..so it cannot be used with further functions which require references (i.e.: VLOOKUP()). Paste this code into a new VBA module:
'Requires filename, sheetname as first argument and cell reference as second argument
'Usage: type in an excel cell -> =getvalue(A1,B1)
'Example of A1 -> C:\TEMP\[FILE1.XLS]SHEET1'
'Example of B1 -> B3
'This will fetch contents of cell (B3) located in (sheet1) of (c:\temp\file1.xls)
'Create a module and paste the code into the module (e.g. Module1, Module2)
Public xlapp As Object
Public Function getvalue(ByVal filename As String, ref As String) As Variant
' Retrieves a value from a closed workbook
Dim arg As String
Dim path As String
Dim file As String
filename = Trim(filename)
path = Mid(filename, 1, InStrRev(filename, "\"))
file = Mid(filename, InStr(1, filename, "[") + 1, InStr(1, filename, "]") - InStr(1, filename, "[") - 1)
If Dir(path & file) = "" Then
getvalue = "File Not Found"
Exit Function
End If
If xlapp Is Nothing Then
'Object must be created only once and not at each function call
Set xlapp = CreateObject("Excel.application")
End If
' Create the argument
arg = "'" & filename & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
'Execute an XLM macro
getvalue = xlapp.ExecuteExcel4Macro(arg)
End Function
Code above
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
Should read
strInfoCell = "'" & strPath & "[" & strFile & "]" & "Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
It is missing " & "
No need for a function
Cheers
Neil
Data = "'" & GetDirectory & "[" & GetFileName & "]" & Sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
Address = "$C$3"
GetDirectory = "C:\Users\my.name\Desktop\"
GetFileName = "QOS DGL stuff.xlsx"
Sheet = "ACL"