Check if Workbook is opened by another user-CodePudding

I have a drop-down menu assigned to a shape, i use it to open others workbooks, but these are shared workbooks, so i want VBA to tell me when the workbook i selected are being used by another user and dont open it, because I need it to be opened in edit mode.

Menu:

My code so far:

Sub MenuSuspenso()
    Application.CommandBars("Cell").Reset
    
    Dim cbc As CommandBarControl
    
    For Each cbc In Application.CommandBars("cell").Controls
        cbc.Visible = False
    Next cbc
    
    With Application.CommandBars("Cell").Controls.Add(temporary:=True)
        .Caption = "AQUAS"
        .OnAction = "AQUAS"
    End With

End Sub

Sub AQUAS()

Dim book As Workbook
Set book = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"

If book.ReadOnly = True Then
MsgBox ("Arquivo em Uso")
book.Close()
app.Quit()

Else

Workbooks.Open ("\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"), True

End Sub

The book comes from a server drive, and have links ( true for UpdateLinks ) and macros.

CodePudding user response：

Please, try the next function. It or its other versions exist on internet from some years. I mean, I am not the one designing it, but I do not know where from I have it:

Function IsWorkBookOpen(FileName As String) As Boolean
    Dim fileCheck As Long, ErrNo As Long

    On Error Resume Next
     fileCheck = FreeFile()
     Open FileName For Input Lock Read As #fileCheck
     Close fileCheck
     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

Now, how to use it...

Firstly, this part of your code is wrong:

Dim book As Workbook
Set book = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"

This should be declared as String, not being Set and check if the workbook is open in the next way:

Sub AQUAS()
 Dim bookPath As String, bookWb As Workbook
 bookPath = "\\T\Public\DOCS\Hualley\FLUXO CAIXA HINDY - 111.xlsm"
 
 'check if its full name is correct:
 If Dir(bookPath) = "" Then MsgBox "The supplied workbook name is wrong...": Exit Sub
 
 If IsWorkBookOpen(bookPath) Then
        MsgBox ("Arquivo em Uso")
 Else
        Set bookWb = Workbooks.Open(bookPath)
        Debug.Print bookWb.Sheets.count 'it returns the number of sheets for the open workbook...
        'Here do whatever you need with the workbook.
 End If
End Sub