In VBA, I opened an MS Excel file named "myWork.XL" programmatically.
Now I would like a code that can tell me about its status - whether it is open or not. I.e. something like IsWorkBookOpened("myWork.XL)
?
Try this:
Option Explicit
Sub Sample()
Dim Ret
Ret = IsWorkBookOpen("C:\myWork.xlsx")
If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
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
For my applications, I generally want to work with a workbook rather than just determine if it's open. For that case, I prefer to skip the Boolean function and just return the workbook.
Sub test()
Dim wb As Workbook
Set wb = GetWorkbook("C:\Users\dick\Dropbox\Excel\Hoops.xls")
If Not wb Is Nothing Then
Debug.Print wb.Name
End If
End Sub
Public Function GetWorkbook(ByVal sFullName As String) As Workbook
Dim sFile As String
Dim wbReturn As Workbook
sFile = Dir(sFullName)
On Error Resume Next
Set wbReturn = Workbooks(sFile)
If wbReturn Is Nothing Then
Set wbReturn = Workbooks.Open(sFullName)
End If
On Error GoTo 0
Set GetWorkbook = wbReturn
End Function
On Error Resume Next
in the code or you have Break on All Errors set under Tools - Options in the VBE.
Commented
Jun 10, 2014 at 18:39
On Error Resume Next
(because wbReturn
was not Nothing
, but contained an error) and write real error handling. See: pastebin.com/u1LLgPa1
Commented
Dec 18, 2017 at 0:09
If its open it will be in the Workbooks collection:
Function BookOpen(strBookName As String) As Boolean
Dim oBk As Workbook
On Error Resume Next
Set oBk = Workbooks(strBookName)
On Error GoTo 0
If oBk Is Nothing Then
BookOpen = False
Else
BookOpen = True
End If
End Function
Sub testbook()
Dim strBookName As String
strBookName = "myWork.xls"
If BookOpen(strBookName) Then
MsgBox strBookName & " is open", vbOKOnly + vbInformation
Else
MsgBox strBookName & " is NOT open", vbOKOnly + vbExclamation
End If
End Sub
I would go with this:
Public Function FileInUse(sFileName) As Boolean
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0
End Function
as sFileName you have to provide direct path to the file for example:
Sub Test_Sub()
myFilePath = "C:\Users\UserName\Desktop\example.xlsx"
If FileInUse(myFilePath) Then
MsgBox "File is Opened"
Else
MsgBox "File is Closed"
End If
End Sub
What if you want to check without creating another Excel instance?
For example, I have a Word macro (which is run repeatedly) that needs to extract data from an Excel spreadsheet. If the spreadsheet is already open in an existing Excel instance, I would prefer not to create a new instance.
I found a great answer here that I built on: http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html
Thanks to MikeTheBike and kirankarnati
Function WorkbookOpen(strWorkBookName As String) As Boolean
'Returns TRUE if the workbook is open
Dim oXL As Excel.Application
Dim oBk As Workbook
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
'Excel is NOT open, so the workbook cannot be open
Err.Clear
WorkbookOpen = False
Else
'Excel is open, check if workbook is open
Set oBk = oXL.Workbooks(strWorkBookName)
If oBk Is Nothing Then
WorkbookOpen = False
Else
WorkbookOpen = True
Set oBk = Nothing
End If
End If
Set oXL = Nothing
End Function
Sub testWorkbookOpen()
Dim strBookName As String
strBookName = "myWork.xls"
If WorkbookOpen(strBookName) Then
msgbox strBookName & " is open", vbOKOnly + vbInformation
Else
msgbox strBookName & " is NOT open", vbOKOnly + vbExclamation
End If
End Sub
This one is a bit easier to understand:
Dim location As String
Dim wbk As Workbook
location = "c:\excel.xls"
Set wbk = Workbooks.Open(location)
'Check to see if file is already open
If wbk.ReadOnly Then
ActiveWorkbook.Close
MsgBox "Cannot update the excelsheet, someone currently using file. Please try again later."
Exit Sub
End If
Checkout this function
'********************************************************************************************************************************************************************************
'Function Name : IsWorkBookOpen(ByVal OWB As String)
'Function Description : Function to check whether specified workbook is open
'Data Parameters : OWB:- Specify name or path to the workbook. eg: "Book1.xlsx" or "C:\Users\UserName\Desktop\Book1.xlsm"
'********************************************************************************************************************************************************************************
Function IsWorkBookOpen(ByVal OWB As String) As Boolean
IsWorkBookOpen = False
Dim WB As Excel.Workbook
Dim WBName As String
Dim WBPath As String
Err.Clear
On Error Resume Next
OWBArray = Split(OWB, Application.PathSeparator)
Set WB = Application.Workbooks(OWBArray(UBound(OWBArray)))
WBName = OWBArray(UBound(OWBArray))
WBPath = WB.Path & Application.PathSeparator & WBName
If Not WB Is Nothing Then
If UBound(OWBArray) > 0 Then
If LCase(WBPath) = LCase(OWB) Then IsWorkBookOpen = True
Else
IsWorkBookOpen = True
End If
End If
Err.Clear
End Function