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
Related
I would like to reference worksheet by index method for the worksheet without open the workbook. However, I don't know how to do it for this. Many example from online is using "Sheet1", which is not my case. For my case, each workbook has its worksheetname, They are all named differently.
Sub excelfor_macro()
Dim p As String, f As String
Dim s As String, a As String
Dim my_array(1 To 8) As String
Dim r As Integer
Application.ScreenUpdating = False
p = "C:\Users\puntek\Desktop\"
f = "490XXZMAV31002S84D6A_002S84D68.xlsx"
s = SHEETNAME(1).Name **'This is where, i want to reference by index, not worksheet name**
For r = 1 To 8
a = Cells(r + 8, 3).Address 'start from row 9 the info
my_array(r) = GetValue(p, f, s, a)
Next r
End Sub
Private Function GetValue(path, file, sheet, ref) 'This is getvalue function, the worksheetname will pass to sheet
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Open the workbook to get the name:
Dim wb as Workbook
p = "C:\Users\puntek\Desktop\"
f = "490XXZMAV31002S84D6A_002S84D68.xlsx"
Set wb = Workbooks.Open(p & f) ' or Set wb = Workbooks.Add(p & f)
s = wb.Worksheets(1).Name
' optionally close the workbook
wb.Close
I have a working code to retrieve a specific cell in a closed workbook when I specify the directory. I'm trying to get this code to loop through all the existing workbooks in said directory, retrieving the same cell from each file.
This is the code I have so far with the loop (I'm including the function used as well):
Private Function GetValueFromClosedWorkbook(path, file, sheet, ref)
Dim arg As String, xFolder As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValueFromClosedWorkbook = "File not found."
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1) 'create the argument
GetValueFromClosedWorkbook = ExecuteExcel4Macro(arg)
End Function
Sub TestGetValueFromClosedWorkbook()
Dim p As String, xFolder As String
Dim s As String, a As String, f(1 To 2) As String, z As Long
xFolder = "\\generic path"
For z = 1 To 2
s = "Sheet1"
a = "A1"
p = xFolder '& "\*.xlsx"
f(z) = Dir(p & "\*.xlsx")
Do While f(z) <> ""
ActiveSheet.Range("A" & (z + 7)) = GetValueFromClosedWorkbook(p, f(z), s, a)
f(z) = Dir()
Loop
Next z
End Sub
This gets the correct cell, and then pastes in the active worksheet in cell A8.
The only issue is that when it loops through the second file, it still gets the cell from the first file. Why is that happening? Or how can I ensure that the second loop it retrieves the cell from the second workbook?
The loops were a bit messed up, and you were overwriting the values. Please see below corrected code:
Sub TestGetValueFromClosedWorkbook()
Dim p As String, xFolder As String
Dim s As String, a As String, f As String, z As Long
xFolder = "\\generic path"
s = "Sheet1"
a = "A1"
p = xFolder '& "\*.xlsx"
f = Dir(p & "\*.xlsx")
Do While f <> ""
ActiveSheet.Range("A" & (z + 7)) = GetValueFromClosedWorkbook(p, f, s, a)
f = Dir()
z = z + 1
Loop
End Sub
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 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."
I have 2 workbooks: "reportPageImpression.xlsx" and "testCloseWorkbook.xslx". Currently I am able to get data from reportPageImpression to testCloseWorkbook when clicking the "Update" button.
What I try to do is when clicking again the "Update" button, the value will go to "Jan-16" (new column) and so on. Here's my code:
Option Explicit
Private Function GetValueFromClosedWorkbook(path, file, sheet, ref)
Dim arg As String
'Let’s check whether the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValueFromClosedWorkbook = "File Not Found"
Exit Function
End If
'We create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
'MsgBox arg
'Now we execute an XLM macro
'All references must be given as R1C1 strings.
GetValueFromClosedWorkbook = ExecuteExcel4Macro(arg)
End Function
Sub TestGetValueFromClosedWorkbook()
Dim p As String, f As String
Dim s As String, a As String
p = ThisWorkbook.path
f = "reportPageImpression.xlsx"
s = "report_page_impression"
a = "D39"
ActiveSheet.Range("C8") = GetValueFromClosedWorkbook(p, f, s, a)
End Sub
ActiveSheet.Cells(Range("C8").Row, Columns.Count).End(xlToLeft).Offset(0, 1) = GetValueFromClosedWorkbook(p, f, s, a)
to check for a cell to be empty you must use a formula like "COUNTA(range)" as the argument of the ExecuteExcel4Macro(arg) method and get back the number of non empty cells in the closed workbook specified range.
If you specify your cell address as its range and it returns zero then that cell is empty otherwise it has a value and then you can use ExecuteExcel4Macro(arg) method again with the cell reference as its argument. In this latter case you may want to use .Offset(rowOffset) method on your original "Range" to shift to a cell rowOffset rows apart from it.
In order not to get lost in references, I'd suggest you to refactor your code and make extensive use of "wrappers" in order to have clean an maintanable code
Here you may find what I've come up to as per my understanding
Sub TestGetValueFromClosedWorkbook()
Dim p As String, f As String
Dim s As String, a As String
Dim argPart As String
Dim var As Variant
Dim checkSheetResult As String
p = ThisWorkbook.path
f = "reportPageImpression.xlsx"
s = "report_page_impression"
a = "D39"
checkSheetResult = CheckSht(p, f) ' check if the file to be read as closed is not already opened and if it exists
If checkSheetResult = "" Then
argPart = "'" & p & "[" & f & "]" & s & "'!" 'set the "constant" part of the argument
var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1)
If var = -1 Then
MsgBox ("No value found!")
Else
ActiveSheet.Cells(Range("C8").row, Columns.Count).End(xlToLeft).Offset(0, 1) = var
End If
Else
MsgBox checkSheetResult
End If
End Sub
Private Function GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variant
Dim arg As String, funcArg As String
Dim var As Variant
Dim rowOffset As Long
If IsMissing(rowOffsetRate) Then rowOffsetRate = 0
rowOffset = 0
funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
var = ExecuteExcel4Macro(funcArg)
Do While var = -1 And CheckIfOffset(ref, CLng(rowOffsetRate), rowOffset)
funcArg = SetArgFunction(ref, argPart, rowOffset, arg)
var = ExecuteExcel4Macro(funcArg)
Loop
If var <> -1 Then var = ExecuteExcel4Macro(arg)
GetFirstNonEmptyValueFromClosedWorkbook = var
End Function
Private Function SetArgFunction(ref As String, argPart As String, rowOffset As Long, arg As String) As String
arg = argPart & Range(ref).Range("A1").Offset(rowOffset).Address(, , xlR1C1)
SetArgFunction = "IF(COUNTA(" & arg & ")>0,1,-1)"
End Function
Private Function CheckIfOffset(ref As String, rowOffsetRate As Long, rowOffset As Long) As Boolean
Dim nextRow As Long
Dim cell As Range
Set cell = Range(ref)
nextRow = cell.Offset(rowOffset).row + rowOffsetRate
CheckIfOffset = rowOffsetRate > 0 And nextRow <= cell.Parent.Cells(cell.Parent.Rows.Count, 1).row _
Or (rowOffsetRate < 0 And nextRow > 0)
If CheckIfOffset Then rowOffset = rowOffset + rowOffsetRate
End Function
Private Function CheckSht(path As String, file As String) As String
Dim wb As Workbook
Dim okSheet As Boolean
If Right(path, 1) <> "\" Then path = path & "\"
On Error Resume Next
Set wb = Workbooks(file)
On Error GoTo 0
okSheet = wb Is Nothing
If Not okSheet Then okSheet = wb.path & "\" <> path
If Not okSheet Then
' file is already open
CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "is already open!"
Else
'Let’s check whether the file exists
If Dir(path & file) = "" Then CheckSht = "workbook:" & vbCrLf & vbCrLf & file & vbCrLf & vbCrLf & "in:" & vbCrLf & vbCrLf & path & vbCrLf & vbCrLf & "not found!"
End If
End Function
the "logic" of shifting to a different cell is all in var = GetFirstNonEmptyValueFromClosedWorkbook(a, argPart, -1) where that -1 is the "rowOffsetRate" that GetFirstNonEmptyValueFromClosedWorkbook(ref As String, argPart As String, Optional rowOffsetRate As Variant) As Variantfunction takes into account if the cell in address a is empty. if no "rowOffsetRate" is passed then it only checks the cell in address a