检测Excel工作簿是否已经打开

我通过编码打开了名为“myWork.XL”的MS Excel文件。 现在我想要一个可以告诉我它的状态的代码 – 不pipe它是否公开。 换句话说，如果我打开相同的文件，它应该告诉我，该文件已经打开。

Answer 1

尝试这个：

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 

Answer 2

对于我的应用程序，我通常希望使用工作簿，而不是仅仅确定是否打开。 对于这种情况，我宁愿跳过布尔函数，只是返回工作簿。

 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 

Answer 3

如果打开它将在Workbooks集合中：

 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 

Answer 4

我会去这个：

 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 

作为sFileName你必须提供文件的直接path，例如：

 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 

Answer 5

如果你想检查而不创build另一个Excel实例呢？

例如，我有一个需要从Excel电子表格中提取数据的Wordmacros（反复运行）。 如果电子表格已经在现有的Excel实例中打开，我不想创build一个新的实例。

我在这里find了一个很好的答案： http : //www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

感谢MikeTheBike和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 

Answer 6

这个比较容易理解：

 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 

Answer 7

检出这个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: "Nucleation.xlsx" or "C:\Users\Kannan.S\Desktop\Nucleation\Nucleation.xlsm" 'Created by : Kannan S 'Email : [e-mail] 'Creation date : 13-Nov-2013 'Website : www.nucleation.in 'THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT 'LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. 'Feel free to use the code as you wish but kindly keep this header section intact. 'Copyright © 2013 Nucleation. All Rights Reserved. '******************************************************************************************************************************************************************************** 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, "\") Set WB = Application.Workbooks(OWBArray(UBound(OWBArray))) WBName = OWBArray(UBound(OWBArray)) WBPath = WB.Path & "\" & 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