The following will establish if the file exists and is opened by yourself or by another user and reports accordingly. If the file exists and is not open it is opened. The example below simply reports what is in cell A1 of Sheet1 to demonstrate that it works. If my messages don't make sense, blame Google .
Sub Livro3()
'Graham Mayor - https://www.gmayor.com - Last updated - 07 Jun 2019
Dim xlApp As Object
Dim xlBook As Object
Dim FSO As Object
Const strWB As String = "Livro2.xlsx"
Const strPath As String = "C:\Users\njesus\Documentos\"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
xlApp.Visible = False
Set xlBook = xlApp.workbooks(strWB)
On Error GoTo 0
If xlBook Is Nothing Then
If Not IsWorkBookOpen(strPath & strWB) = True Then
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(strPath & strWB) Then
Set xlBook = xlApp.workbooks.Open(strPath & strWB)
MsgBox xlBook.sheets(1).Range("A1")
Else
MsgBox strPath & strWB & vbCr & "Não encontrado!"
End If
Else
MsgBox "O arquivo está em uso por outro usuário."
End If
End If
lbl_Exit:
Set xlApp = Nothing
Set xlBook = Nothing
Set FSO = Nothing
Exit Sub
End Sub
Private Function IsWorkBookOpen(FileName As String)
'https://stackoverflow.com/questions/9373082/detect-whether-excel-workbook-is-already-open#9373914
'with slight modification by Graham Mayor - https://www.gmayor.com - Last updated - 07 Jun 2019
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: IsWorkBookOpen = False
End Select
lbl_Exit:
Exit Function
End Function