programing

Excel 워크북이 이미 열려 있는지 감지

fastcode 2023. 4. 10. 22:21
반응형

Excel 워크북이 이미 열려 있는지 감지

VBA에서 myWork라는 이름의 MS Excel 파일을 열었습니다.프로그램적으로 XL"입니다.

이제 오픈 여부에 관계없이 상태를 알 수 있는 코드를 원합니다.예를 들면...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

제 어플리케이션의 경우 일반적으로 워크북이 열려 있는지 여부를 판단하는 것이 아니라 워크북을 사용하여 작업하고 싶습니다.이 경우 Boolean 함수를 건너뛰고 워크북을 반환하는 것이 좋습니다.

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

열려 있는 경우 워크북 컬렉션에 포함됩니다.

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

다른 Excel 인스턴스를 생성하지 않고 확인하고 싶다면 어떻게 해야 합니까?

예를 들어 Excel 스프레드시트에서 데이터를 추출해야 하는 Word 매크로(반복 실행)가 있습니다.기존 Excel 인스턴스에서 스프레드시트가 이미 열려 있다면 새 인스턴스를 만들지 않는 것이 좋습니다.

제가 구축한 훌륭한 답변은 http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html입니다.http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

Mike The Bike와 Kirankaraty 덕분에

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

언급URL : https://stackoverflow.com/questions/9373082/detect-whether-excel-workbook-is-already-open

반응형