Detect whether Excel workbook is already open

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 

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