检测 Excel 工作簿是否已打开

试试这个:

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

如果打开它，它将在工作簿集合中:

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

对于我的应用程序，我通常希望使用工作簿，而不是仅仅确定它是否打开。在这种情况下，我倾向于跳过布尔函数，直接返回工作簿。

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

这一点比较容易理解:

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

如果您想在不创建另一个 Excel 实例的情况下进行检查，该怎么办？

例如，我有一个 Word 宏(重复运行) ，它需要从 Excel 电子表格中提取数据。如果电子表格已经在现有的 Excel 实例中打开，我不希望创建新实例。

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

多亏了 Mike 和 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

检查这个函数

'********************************************************************************************************************************************************************************
'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\Kannan.S\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

我会这么说:

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，您必须提供文件的直接路径，例如:

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