UserDefined Function that opens another w/book

R

Regan

I am trying to create a customied funtion in XL. But
things aren't working to plan.... Here's the stats...

I have a spreadsheet that looks like this (with the first
row being headers)

Path Spec Cy Sheet Range
D:\Test 123 ABC sheet1 skimmilk

I would like to write a function for column F similar to
the following

=DataValue(a2,b2,c2,d2,e2)

Simple enough I thought, so I composed the code below
where I open another w/book as specified in the paramaters
and retreive the value. (This will open a workbook on each
calculation, but I happy with this performance hit.)

BUT IT DOESN'T WORK. It does work when called from a
subroutine. but not from a function !!!!! - Why is this??

(the sub routine "SubDataValue" works- pasted at the end
of this post - this essentially mimics what the formular
=DataValue(a2,b2,c2,d2,e2) would do on calculation.

Can anyone offer any insite??



Option Explicit
Option Compare Text

'****************
Function DataValue(strPath As String, strSpec As String,
strCypher As String, _
strSHeet As String, strRange As String)
'purpose = to retrive a specific cell from another w/book
'On Error GoTo DataValue_err

Dim strFilePath As String
Dim strFileName As String
strFileName = strSpec & strCypher & ".xls"
strFilePath = strPath & "\" & strFileName

If OpenBook(strFilePath) = True Then
'get the datavalue
DataValue = Workbooks(strFileName).Sheets
(strSHeet).Range(strRange).Value
Else
MsgBox "cannot find the file: " & strFilePath
End If

Exit Function


DataValue_err:
MsgBox Err.Number & " " & Err.Description

End Function


'****************

Function OpenBook(strFilePath As String) As Boolean
' This procedure checks to see if the workbook
' specified in the strFilePath argument is open.
' If it is open, the workbook is activated. If it is
' not open, the procedure opens it.
Dim wkbCurrent As Excel.Workbook
Dim strBookName As String

On Error GoTo OpenBook_Err

' Determine the name portion of the strFilePath
argument.
strBookName = NameFromPath(strFilePath)
If Len(strBookName) = 0 Then Exit Function
If Workbooks.Count > 0 Then
For Each wkbCurrent In Workbooks
If UCase$(wkbCurrent.Name) =
UCase$(strBookName) Then
OpenBook = True
'wkbCurrent.Activate
Exit Function
End If
Next wkbCurrent
End If
Workbooks.Open strFilePath, , True
OpenBook = True

OpenBook_End:
Exit Function
OpenBook_Err:
OpenBook = False
Resume OpenBook_End
End Function

'*****************
Function NameFromPath(strPath As String) As String
' This procedure takes a file path and returns
' the file name portion.

Dim lngPos As Long
Dim strPart As String
Dim blnIncludesFile As Boolean

' Check that this is a file path.
' Find the last path separator.
lngPos = InStrRev(strPath, "\")
' Determine if string after last backslash
' contains a period.
blnIncludesFile = InStrRev(strPath, ".") > lngPos
strPart = ""

If lngPos > 0 Then
If blnIncludesFile Then
strPart = Right$(strPath, Len(strPath) -
lngPos)
End If
End If
NameFromPath = strPart
End Function


'********

Sub SubDataValue()
Dim strFilePath As String
Dim strSHeet
Dim strRange
Dim strFileName
strFileName = "readbook.xls"

strFilePath = "D:\Test\readbook.xls"
strSHeet = "sheet1"
strRange = "Skimmilk"

If OpenBook(strFilePath) = True Then
'get the datavalue
MsgBox Workbooks(strFileName).Sheets(strSHeet).Range
(strRange).Value
End If
End Sub
 
R

Regan

Thanks. I thought as much, But I couldn't find any
documentation say so. Ah well, It was worth trying...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top