vba 从函数返回工作簿对象

Returning workbook object from function

提问by JamesFaix

I'm using VBA w/ Excel 2010 and am trying to create (what seems like it should be) a simple function. I want the function to receive a string argument and, if the string matches the name of an open workbook, return a reference to that workbook object; if no match is found it should return "#NAME?". (The function also tries concatenating common file extensions to get a match, for user-friendliness.)

我正在使用带有 Excel 2010 的 VBA，并且正在尝试创建（看起来应该是）一个简单的函数。我希望该函数接收一个字符串参数，如果该字符串与打开的工作簿的名称匹配，则返回对该工作簿对象的引用；如果未找到匹配项，则应返回“#NAME?”。（为了用户友好，该函数还尝试连接常见的文件扩展名以获得匹配。）

Here's what it looks like:

这是它的样子：

Function BookFromName(bookName As String) As Workbook

    Dim wb As Workbook

    For Each wb In Workbooks
        Select Case (wb.Name)
            Case bookName, _
                bookName & ".xls", _
                bookName & ".xlsx", _
                bookName & ".xlsm":
                Set BookFromName = wb
                Exit Function
         End Select
    Next

    MsgBox ("Workbook '" & bookName & "' is not open.")
    BookFromName = CVErr(xlErrName)
End Function

Right now I'm getting the error: "Run-time error 438: Object doesn't support this property or method."From this line:

现在我收到错误消息：“运行时错误 438：对象不支持此属性或方法。” 从这一行：

Set BookFromName = wb

I tried switching the return type to Variant or Object, but it doesn't change anything.

我尝试将返回类型切换为 Variant 或 Object，但它没有改变任何内容。

I also tried removing SET from the line (even though that doesn't seem correct to me), which changes the error to "Run-time error 91: Object variable or With block variable not set."

我还尝试从行中删除 SET（即使这对我来说似乎不正确），这将错误更改为“运行时错误 91：对象变量或块变量未设置”。

I scanned Google and StackExchange for a while, but I can't find any examples of a function returning a workbook object, and not just the name of a workbook.

我扫描了 Google 和 StackExchange 一段时间，但找不到任何返回工作簿对象的函数示例，而不仅仅是工作簿的名称。

---

---

Here is Veve's suggestion, which works fine, but I would prefer to pass references:

这是 Veve 的建议，效果很好，但我更愿意传递引用：

Function BookFromName(bookName As String) As Variant

    Dim wb As Workbook

    For Each wb In Workbooks
        Select Case (wb.Name)
            Case bookName, _
                bookName & ".xls", _
                bookName & ".xlsx", _
                bookName & ".xlsm":
                BookFromName = wb.Name
                Exit Function
        End Select
    Next
    MsgBox ("Workbook '" & bookName & "' is not open.")
    BookFromName = CVErr(xlErrName)
End Function

采纳答案by dee

Very important is to know how/where your function will be called.

非常重要的是要知道如何/在何处调用您的函数。

• When called from Sheet cell(s)then it can't return reference to Workbook (see example BookFromName1)
• When called from within other VBA codethen it shouldn't use CVErr (see example BookFromName2)

• 当从工作表单元格调用时，它不能返回对工作簿的引用（参见示例 BookFromName1）
• 当从其他VBA 代码中调用时，它不应该使用 CVErr （参见示例 BookFromName2）

Note: using Likethe workbook name extension can be omitted.

注意：使用Like工作簿扩展名可以省略。

HTH

HTH

' As 'User Defined Function' (functions that are called directly from worksheet cells)
Function BookFromName1(bookName As String) As Variant

    On Error Resume Next
    Dim tempWorkbook As Workbook
    Dim isOpen As Boolean
    Dim bookNameLike As String
    bookNameLike = LCase(bookName) & "*"
    For Each tempWorkbook In Workbooks
        If LCase(tempWorkbook.Name) Like bookNameLike Then
            isOpen = True
            Exit For
        End If
    Next
    On Error GoTo 0

    If Not isOpen Then
        MsgBox ("Workbook '" & bookName & "' is not open.")

        ' return error #NAME? to the cell which called this formula
        BookFromName1 = CVErr(xlErrName)
    Else
        ' returns TRUE to the cell which called this formula
        BookFromName1 = True
    End If
End Function

' As common VBA function (used in another VBA code)
Function BookFromName2(bookName As String) As Workbook

    On Error Resume Next
    Dim tempWorkbook As Workbook
    Dim bookNameLike As String
    bookNameLike = LCase(bookName) & "*"
    For Each tempWorkbook In Workbooks
        If LCase(tempWorkbook.Name) Like bookNameLike Then
            Set BookFromName2 = tempWorkbook
            Exit For
        End If
    Next
    On Error GoTo 0

    If BookFromName2 Is Nothing Then
        Dim errorMessage As String
        errorMessage = "Workbook '" & bookName & "' is not open."
        MsgBox errorMessage
        ' In this case (differently from UDF) you can't use CVErr
        ' but you could raise error if you wish.
        ' (Or outcomment Err.Raise and simply return Nothing.)
        Err.Raise vbObjectError + 513, "BookFromName2", errorMessage
    End If
End Function

Sub TestBookFromName2()
    Dim myBook As Workbook
    On Error GoTo errHandler
    ' Like is used to compere book names so the .xls, .xlsx etc. can be omitted
    Set myBook = BookFromName2("SomeBookNameHere")
    Exit Sub
errHandler:
    MsgBox Err.Description, vbExclamation
End Sub

回答by Maciej Los

I'd suggest to use function like:

我建议使用如下函数：

Function IsWbkOpen(ByVal sName As String) As Boolean
Dim extensions As Variant, retVal As Boolean, wbk As Workbook
Dim i As Integer

retVal = False
extensions = Array("", ".xls", ".xslx", ".xlsm")

On Error Resume Next 'ignore errors

For i = LBound(extensions) To UBound(extensions)
    Set wbk = Application.Workbooks(sName & extensions(i))
    If Not wbk Is Nothing Then retVal = True: Exit For
Next

IsWbkOpen = retVal

End Function

Then you'll be able to create procedure:

然后你就可以创建过程：

Sub Test()
Dim wbk As Workbook, wbkName As String

wbkName = "Workbook1"
If Not IsWbkOpen(wbkName) Then
    'call FileOpenDialog
End If

'proceed 

End Sub

Create objects inside function only when you sure that function can create object, unless it will return Nothing(which is unexpected, undesirable).

仅当您确定该函数可以创建对象时才在函数内部创建对象，除非它不会返回Nothing（这是意外的，不可取的）。

Below is function which opens Workbook by its full name. Of course, there is need to add Error handler.

下面是按全名打开工作簿的函数。当然，还需要添加Error handler。

Function CreateWbkFromName(ByVal sFullName As String) as Workbook

    If Dir(sFullName)<>"" Then
        Set CreateWbkFromName= Application.Workbooks.Open(sFullName)
    Else
        'here is a danger of Nothing
    End If
End Function

Cheers,
Maciej

干杯，
马切伊

回答by HarveyFrench

The code by Maciej Los is nice, I would use his.

Maciej Los 的代码很好，我会使用他的。

To work, your code needs changing as follows (see code comments), I hope this helps you understand your code better. Here's the results of calling it

为了工作，你的代码需要改变如下（见代码注释），我希望这有助于你更好地理解你的代码。这是调用它的结果

? BookFromName(thisworkbook.Name).Name
Book1
? BookFromName("Not open") is nothing
True



Function BookFromName(bookName As String) As Workbook

    Dim wb As Workbook

    For Each wb In Workbooks
        Select Case (wb.Name)
            Case bookName   
                ' NOTE  NO ":" IS NEEDED as it is a "command break" character 
                '       wb.Name does not return the file extension only the filename.
                Set BookFromName = wb                           ' SET ADDED
                Exit Function
         End Select
    Next

    MsgBox ("Workbook '" & bookName & "' is not open.")
    Set BookFromName = Nothing                                
               ' ADD SET AND USE NOTHING
               ' CVErr(xlErrName) would only be used if you are calling from an excel cell.
               ' As this returns and object this function will not be used 
               ' from excel 
               ' In the calling function test for is nothing to find if a workbook was found
End Function

回答by Patrick Lepelletier

you didn't consider case sensitive, so try this instead :

你没有考虑区分大小写，所以试试这个：

Function BookFromName(bookName As String) As Workbook

Dim wb As Workbook
dim h$
bookName = Ucase (bookName)

For Each wb In Workbooks
        h = ucase (wb.name)
        if h = bookName & ".XLS" or h = bookName & ".XLSX" or h = bookName & ".XLSM" then 
            Set BookFromName = wb
            set wb = nothing
            Exit Function
        end if
Next wb

set wb = nothing
beep
MsgBox ("Workbook '" & bookName & "' is not open.")
'BookFromName = CVErr(xlErrName)
End Function

回答by mememoremore

I tried your first function Function BookFromName(bookName As String) As Workbookin Excel 2007 and it works fine. I run it like following, where I have BS.xlsm opening at the same time.

我在 Excel 2007 中尝试了你的第一个函数Function BookFromName(bookName As String) As Workbook，它工作正常。我像下面一样运行它，同时打开 BS.xlsm。

Function BookFromName(bookName As String) As Workbook

    Dim wb As Workbook

    For Each wb In Workbooks
        Select Case (wb.Name)
            Case bookName, _
                bookName & ".xls", _
                bookName & ".xlsx", _
                bookName & ".xlsm":
                Set BookFromName = wb
                Exit Function
         End Select
    Next

    MsgBox ("Workbook '" & bookName & "' is not open.")
    BookFromName = CVErr(xlErrName)
End Function


Sub main()
 Dim wb As Workbook
 set wb = BookFromName("BS")
 MsgBox wb.Name
End Sub

Alternatively, how about rewrite your function to pass parameters by reference

或者，如何重写您的函数以通过引用传递参数

Sub BookFromName(bookName As String, byref wb as workbook)

Sub BookFromName(bookName As String, byref wb as workbook)

whatever you assigned to wb variable in function BookFromName, it still exists after BookFromName function ended.

无论你在函数 BookFromName 中分配给 wb 变量，它在 BookFromName 函数结束后仍然存在。