Wykryj, czy skoroszyt programu Excel jest już otwarty.

Question

Otworzyłem plik programu MS Excel nazwany jako "myWork.XL" poprzez kodowanie. Teraz chcę kod, który może powiedzieć mi o jego statusie - czy jest otwarty, czy nie. Innymi słowy, jeśli otworzę ten sam plik, powinien mi powiedzieć, że plik jest już otwarty.

Answer 1

Spróbuj tego:

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

Jeśli jej otwarty będzie w zbiorach skoroszyty:

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 3

Dla moich zastosowań, ja generalnie chcą pracować z skoroszycie zamiast po prostu ustalić, czy jest to otwarty. W tym przypadku wolę pominąć funkcję Boolean i po prostu zwrócić skoroszyt.

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 4

Ten jest nieco łatwiejsze do zrozumienia:

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 5

Co zrobić, jeśli chcesz sprawdzić bez tworzenia innego wystąpienia programu Excel?

Na przykład, mam makro Word (które jest uruchamiane wielokrotnie), które musi wyodrębnić dane z arkusza kalkulacyjnego programu Excel. Jeśli arkusz kalkulacyjny jest już otwarty w istniejącej instancji programu Excel, wolałbym nie tworzyć nowej instancji.

znalazłem wielką odpowiedzi tutaj, że opiera się na: http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

Dzięki MikeTheBike i 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

Zamówienie tę funkcję

Function to Check Whether a Workbook is Open

Kod z linkiem dodanej

'******************************************************************************************************************************************************************************** 
'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         : info@nucleation.in 
'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 

Answer 7

pójdę z tym:

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 

jak sFileName trzeba zapewnić bezpośrednią ścieżkę do pliku, na przykład:

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