Excel VBA检查文件是否打开功能

Question

这似乎是一个简单的功能，解决方案应该是直截了当的，但我找不到问题。

我有一个在子程序中调用的函数，它检查文件是否打开，如果没有打开它。 该函数运行完美，但是当它返回到调用它的主 sub 时，变量（True 或 False）失去了它的值，我收到错误 9: subscript out of range 在Set wb = Workbooks(MasterFileF) 行在主子中。

Function wbOpen(wbName As String) As Boolean
Dim wbO As Workbook

    On Error Resume Next
        Set wbO = Workbooks(wbName)
        wbOpen = Not wbO Is Nothing
        Set wbO = Nothing

End Function



Sub Macro5()

Dim wb As Workbook
Dim path As String
Dim MasterFile As String
Dim MasterFileF As String


Application.ScreenUpdating = False

'Get folder path
path = GetFolder()
If path = "" Then
    MsgBox "No folder selected. Please start macro again and select a folder"
    Exit Sub
Else
End If


MasterFile = Dir(path & "\*Master data*.xls*")
MasterFileF = path & "\" & MasterFile

'Check if workbook open if not open it
If wbOpen(MasterFile) = True Then
    Set wb = Workbooks(MasterFileF)
Else
    Set wb = Workbooks.Open(MasterFileF)
End If

函数变量的值在返回主子时丢失，我哪里出错了？

Answer 1

我会稍微修改一下你的代码：

让WbOpen() 函数通过其参数返回打开的工作簿（如果找到）

Function wbOpen(wbName As String, wbO As Workbook) As Boolean
    On Error Resume Next
    Set wbO = Workbooks(wbName)
    wbOpen = Not wbO Is Nothing
End Function

然后在你的主代码中简单地去：

MasterFile = Dir(path & "\*Master data*.xls*")

If Not wbOpen(MasterFile, wb) Then Set wb = Workbooks.Open(path & "\" & MasterFile)

编辑

添加一个增强版本来处理同名但不同路径的工作簿

在这种情况下，您必须同时检查文件名和路径，但步骤不同

所以WbOpen()函数变成：

Function wbOpen(wbName As String, wbPath As String, wbO As Workbook) As Boolean
    On Error Resume Next
    Set wbO = Workbooks(wbName)
    On Error GoTo 0 ' restore error handling back
    
    If Not wbO Is Nothing Then ' in current excel session there already is an open workbook with same name (path excluded) as the searched one
    
        If wbO.path = wbPath Then ' the already open workbook has the same path as the searched one -> we got it!
            
            wbOpen = True
            
        Else ' the already open workbook has a different path from the searched one -> we must investigate ...
            
            If MsgBox("A workbook named after:" _
                       & vbCrLf & vbCrLf & vbTab & wbName _
                       & vbCrLf & vbCrLf & " is already open but its path is different from:" _
                       & vbCrLf & vbCrLf & vbTab & wbPath _
                       & vbCrLf & vbCrLf & "If you want to open the new found one, the already open one will be closed" _
                       & vbCrLf & vbCrLf & vbCrLf & "Do you want to open the new found one?", vbQuestion + vbYesNo) = vbYes Then
                
                wbO.Close True ' close the currently opened workbook with same name but different path from searched one
                               ' the opening of the new one will be made in the main sub, after this function returning 'False'
            Else
                wbOpen = True ' you chose not to open the searched one and stay with the currently open one -> return 'True' to say you are done
            End If
            
        End If
            
    End If
    
End Function

您的主要代码的相关部分将更改为：

MasterFile = Dir(path & "\*.xls*")

If Not wbOpen(MasterFile, path, wb) Then Set wb = Workbooks.Open(path & "\" & MasterFile)

Answer 2

我认为问题在于您的wbOpen 函数。您在本地设置该工作簿对象，而不是返回 Boolean 的值。见下文：

Function wbOpen(ByVal wbName As String) As Boolean

    Dim wbO As Workbook

    For Each wbO In Application.Workbooks
        If InStr(1, wbO.Name, wbName) Then
            wbOpen = True
            Exit Function
        End If
    Next wbO

    wbOpen = False

End Function



Sub Macro5()

    Dim wb As Workbook
    Dim path As String
    Dim MasterFile As String
    Dim MasterFileF As String

    Application.ScreenUpdating = False

    'Get folder path
    path = GetFolder()
    If path = "" Then
        MsgBox "No folder selected. Please start macro again and select a folder"
        Application.ScreenUpdating = True
        Exit Sub
    End If

    MasterFile = Dir(path & "\*Master data*.xls*")
    MasterFileF = path & "\" & MasterFile

    'Check if workbook open if not open it
    If wbOpen(MasterFile) = True Then
        Set wb = Workbooks(MasterFileF)
    Else
        Set wb = Workbooks.Open(MasterFileF)
    End If

    Application.ScreenUpdating = True

End Sub