在VBA中,我通过编程方式打开了名为“myWork.XL”的MS Excel文件。
现在我想要一段代码,可以告诉我它的状态 - 是否已经打开。即类似于
现在我想要一段代码,可以告诉我它的状态 - 是否已经打开。即类似于
IsWorkBookOpened("myWork.XL)
?试试这个:
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
在我的应用程序中,通常我希望使用工作簿而不仅仅是确定它是否已被打开。对于这种情况,我更喜欢跳过布尔函数,直接返回工作簿。
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
Workbooks(sFile)
上给我一个越界错误。 - motobóiOn Error Resume Next
,或者在 VBE 的工具 - 选项中设置了“在所有错误上中断”。 - Dick KusleikaOn Error Resume Next
(因为wbReturn
不是Nothing
,而是包含一个错误),并编写真正的错误处理程序。请参见:https://pastebin.com/u1LLgPa1 - André Chalella如果它是打开的,它将在工作簿集合中:
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
我会选择这个方案:
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
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
这个比较容易理解:
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
查看这个函数
'********************************************************************************************************************************************************************************
'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
WB.Path & "\" & WBName
就是 WB.FullName
。 - Winand