简体   繁体   中英

How to check if a workbook is open and use it

I've made a macro to open two workbooks and do some stuff with them. This macro runs from a third workbook that calls any other two user selected workbooks for which, before they're opened, I don't know their name. So! I know Excel 2010 doesn't have a built in function to check if a workbook is open so, I've been trying to compare the workbook against Nothing but it doesn't work and every workaround I find in different sites tend to use the name of the workbook.
Is there another way of doing this?
The idea is to run a macro with the two user defined workbooks and then, maybe, re-running it in the same workbooks but Excel warms me of discarding changes.
Maybe a workaround could be to tell excel when it prompts for reopening, not to reopen and handle that error to just use the same workbooks, for which at least, I know how part or the names will be.
For example, one will have the text "cluster" in it, and the other the word "translation" so, maybe in a loop like
the next one, I could find and use the workbook I need but just If I already checked if it's open. Or, does this way works to see if it's opened already?

 For each wbk in Application.Workbooks
    If wbk.Name Like "*cluster*" Then
       WorkingWorkbook = wbk.Name
    End If
 next

My code is as follows:

 Sub structure()
    Application.ScreenUpdating = False
    Dim translationWorkbook As Worksheet
    Dim clusterWorkbook As Workbook

    If Not clusterWorkbook Is Nothing Then
      Set clusterWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E5").Value2)
    Else
      Set clusterWorkbook = Application.Workbooks(parseFilePath(ThisWorkbook.Sheets(1).Range("E5")))
    End If
      Set translationWorkbook = Application.Workbooks.Open(ThisWorkbook.Sheets(1).Range("E6").Value2).Worksheets("String_IDs_Cluster") 'Translation table target for completing
 End Sub

The parameter passed to Workbooks.Open is the one written in the sheet by my next function:

 Private Sub MS_Select_Click()
    Dim File As Variant
    Dim Filt As String

    Filt = "Excel 97-2003 File(*.xls), *.xls," & "Excel File(*.xlsx),*.xlsx," & "Excel Macro File (*.xlsm),*.xlsm"
    File = Application.GetOpenFilename(FileFilter:=Filt, FilterIndex:=2, Title:="Select Menu Structure File")
    If File = False Or File = "" Then
        MsgBox "No File Selected"
        Exit Sub
    End If
    ThisWorkbook.ActiveSheet.Range("E5").Value2 = File
 End Sub

Same for translationWorkbook but in a different cell and also, I was trying to create a function to parse and use the filename in a full path(Then I discovered the command Dir lol) but when I pass the filename, without the xls extension to Application.Workbooks(file) it sends me a "subscript range error".
Why could that be?
Basically my questions are:

  • How can I check for an open workbook and use it? Either by handling the error for excel's prompt or by not trying to reopen the same file.
  • Why does trying to open a workbook with Application.Workbooks() with the return of my function fails? And here my question splits in two... First: with my function, wouldn't it work if I give a string as an argument? Or maybe, before passing it as an argument, I need to assign the result of my function to a variable?
  • Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another "subscript error" but, before I used the File Dialog prompt, I made it this way and worked fine.

Any help will be appreciated.

EDIT

Function ParseFilePath added:

 Function parseFilePath(fullpath As Range) As String
    Dim found As Boolean
    Dim contStart As Integer
    Dim contEnd As Integer
    contEnd = InStr(fullpath, ".") - 1
    contStart = contEnd
    found = False
    Do While found = False
        If fullpath.Characters(contStart, 1).Text = "\" Then
            found = True
        Else
            contStart = contStart - 1
        End If
    Loop
    parseFilePath = fullpath.Characters(contStart + 1, (contEnd - contStart)).Text
 End Function
  1. How can I check for an open workbook and use it? Either by handling the error for excel's prompt or by not trying to reopen the same file.

Have done some small modifications to your procedure structure . Similar to what you were trying testing for the workbook variable to be nothing, only that you have to first attempt to set the variable, the way you were doing it will always return empty as you did not try to set it before. I have also tested for the translation workbook, as it mightt be open as well.

I'm assuming the values in E5 and E6 contain the FullName of the workbook (ie path + filename) and that parseFilePath is a function to extract the filename from the FullName .

Sub structure()
    Application.ScreenUpdating = False
    Dim clusterWorkbook As Workbook
    Dim translationWorkbook As Workbook
    Dim translationWorksheet As Worksheet

    With ThisWorkbook.Sheets(1)

        On Error Resume Next
        Set clusterWorkbook = Application.Workbooks(parseFilePath(.Range("E5").Value2))
        On Error GoTo 0
        If clusterWorkbook Is Nothing Then Set clusterWorkbook = Application.Workbooks.Open(.Range("E5").Value2)

        'Set Translation table target for completing
        On Error Resume Next
        Set translationWorkbook = Application.Workbooks(parseFilePath(.Range("E6").Value2))
        On Error GoTo 0
        If translationWorkbook Is Nothing Then
            Set translationWorksheet = Application.Workbooks.Open(.Range("E6").Value2).Sheets("String_IDs_Cluster")
        Else
            Set translationWorksheet = translationWorkbook.Sheets("String_IDs_Cluster")
        End If

    End With

End Sub
  1. Why does trying to open a workbook with Application.Workbooks() with the return of my function fails? And here my question splits in two... First: with my function, wouldn't it work if I give a string as an argument? Or maybe, before passing it as an argument, I need to assign the result of my function to a variable?

Not sure why it did not work, change the prodedure as indicated.

I tested the procedure above using this function to extract the Filename from the Fullname and it worked:

Function parseFilePath(sFullName As String) As String
    parseFilePath = Right(sFullName, Len(sFullName) - InStrRev(sFullName, "\"))
End Function
  1. Second: If I try to open a workbook like this Application.Workbooks("clusterworkbook") it sends me another "subscript error" but, before I used the File Dialog prompt, I made it this way and worked fine.

Bear in mind that you did not used that line alone, it most probably has something like:

set Workbook = Application.Workbooks("clusterworkbook")

So the command was to set a variable, not to open the workbook, as such the only situation in which this works is that the workbook is already open so the variable gets set. The times when it failed was when the workbook was not open and you tried to set the variable, given you an error.

Suggest to visit these pages Excel Objects , On Error Statement

I have been using the below code to identify if the excel workbook is open. If yes, then i activate it and do some stuff. If not, i open it and do some stuff.

sub test()
    Dim Ret

        Ret = IsWorkBookOpen("Your excel workbook full path")

        If Ret = False Then
        Workbooks.Open FileName:="Your excel workbook full path", UpdateLinks:=False
        Else
        Workbooks("Workbook name").Activate
        End If
end sub
    Function IsWorkBookOpen(FileName As String)
        Dim ff As Long, ErrNo As Long

        On Error Resume Next
        ff = FreeFile()
        Open FileName For Input Lock Read As #ff
        Close ff
        ErrNo = Err
        On Error GoTo 0

        Select Case ErrNo
        Case 0:    IsWorkBookOpen = False
        Case 70:   IsWorkBookOpen = True
        Case Else: Error ErrNo
        End Select
    End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM