2012-06-28 2 views
2

이 질문은 이전 질문에서 계속됩니다. here. Excel 파일이 Outlook 매크로 (Office 2010)에서 로컬로 열리는 지 확인하기 위해 제안 된 수정을 사용하고 있지만 예상대로 작동하지 않습니다. 아마도 내 코드가 실패 할 수 있습니다.Excel이 열려 있는지 확인하십시오 (다른 Office 2010 응용 프로그램에서)

Public Sub UpdateFileIndex(ByVal FullFilePath As String, ByVal DocNo As String) 
    Dim xlApp As Excel.Application 
    Dim xlBook As Excel.Workbook 
    Dim xlSheet As Excel.WorkSheet 

    On Error Resume Next 
    Set xlApp = GetObject(FullFilePath).Application 
    Debug.Print "Error = " & Err 

    If Err.Number = 0 Then ' Workbook is open locally 
     ' Do stuff 
    ElseIf Err.Number = 429 Then ' Workbook is not open locally 
     ' Do different stuff 
    End If 

    ' Do a bunch of other stuff 
End Sub 
FullFilePath (예를 들어 "C:\Data\Data.xlsx")에 의해 주어진 개방 또는 폐쇄 파일에 대한 지금

:

  • Set xlApp = GetObject(FullFilePath).Application

나에게 0 오류 중 하나 방법을 제공합니다. (가 열려 아니라면 즉,이 파일을 엽니 다.)

  • Set xlApp = GetObject(Dir(FullFilePath)).Application

저를 제공 -214722120 두 경우 모두에 대해. (자동화 오류)

  • Set xlApp = GetObject(, "Excel.Application")

0시 공개와 429 때 공개하지 말라고 제공합니다. 아하?! 아래를 참조하십시오. Set xlApp = GetObject(Dir(FullFilePath), "Excel.Application")

  • 나에게 두 경우 모두에 대한 (432)을 제공합니다. Set xlApp = GetObject(FullFilePath, "Excel.Application")

  • 나에게 두 경우 모두에 대한 (432)를 제공합니다 (파일 이름이나 클래스 이름은 자동화 작업을 수행하는 동안 찾을 수 없음).

    작동하는 유일한 경우는 로컬에서 열린 Excel의 첫 번째 인스턴스에 있지 않는 한 파일을 찾을 수없는 초기에 제안 된 수정입니다 (맨 위 링크 참조). 항상 그렇지는 않습니다 (즉, 두 번째 인스턴스에서 엽니 다.)

    내가 잘못했거나 확인하는 데이 방법을 사용하지 않아야합니까? 궁극적으로 파일이 네트워크에 열려 있는지 확인한 다음 로컬로 열려 있는지 확인합니다.

답변

5

여러 개의 Excel 인스턴스가있는 경우 이것이 내가 제안하는 것입니다. 통합 문서 열거 나하지

논리

  1. 확인합니다. 열려 있지 않으면 열어주십시오.
  2. 열려 있으면 모든 Excel 인스턴스에있을 수 있습니다.
  3. Excel 인스턴스를 찾고 관련 통합 문서로 바인딩하십시오.

GetObject Excel 인스턴스를 닫지 않는 한 불행히도 매번 같은 인스턴스가 반환됩니다. 또한 모든 Excel 인스턴스를 반복 할 수있는 확실한 방법은 없습니다. 신뢰성에 대해 말하면, API에주의를 기울일 것입니다. 우리가 사용하는 3 API는 FindWindowEx, GetDesktopWindowAccessibleObjectFromWindow&

이 예제를 (시도 및 Excel 2010에서 테스트) 당신이 파일이 열려인지 아닌지 확인하는 경우 개체를 얻을 수

Option Explicit 

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ 
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _ 
ByVal lpsz2 As String) As Long 

Private Declare Function GetDesktopWindow Lib "user32"() As Long 

Private Declare Function AccessibleObjectFromWindow& Lib "oleacc" _ 
(ByVal hwnd&, ByVal dwId&, riid As GUID, xlWB As Object) 

Private Const OBJID_NATIVEOM = &HFFFFFFF0 

Private Type GUID 
    lData1 As Long 
    iData2 As Integer 
    iData3 As Integer 
    aBData4(0 To 7) As Byte 
End Type 

Sub Sample() 
    Dim Ret 
    Dim oXLApp As Object, wb As Object 
    Dim sPath As String, sFileName As String, SFile As String, filewithoutExt As String 
    Dim IDispatch As GUID 

    sPath = "C:\Users\Chris\Desktop\" 
    sFileName = "Data.xlsx": filewithoutExt = "Data" 
    SFile = sPath & sFileName 

    Ret = IsWorkBookOpen(SFile) 

    '~~> If file is open 
    If Ret = True Then 
     Dim dsktpHwnd As Long, hwnd As Long, mWnd As Long, cWnd As Long 

     SetIDispatch IDispatch 

     dsktpHwnd = GetDesktopWindow 

     hwnd = FindWindowEx(dsktpHwnd, 0&, "XLMAIN", vbNullString) 

     mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString) 

     While mWnd <> 0 And cWnd = 0 
      cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", filewithoutExt) 
      hwnd = FindWindowEx(dsktpHwnd, hwnd, "XLMAIN", vbNullString) 
      mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString) 
     Wend 

     '~~> We got the handle of the Excel instance which has the file 
     If cWnd > 0 Then 
      '~~> Bind with the Instance 
      Call AccessibleObjectFromWindow(cWnd, OBJID_NATIVEOM, IDispatch, wb) 
      '~~> Work with the file 
      With wb.Application.Workbooks(sFileName) 
       ' 
       '~~> Rest of the code 
       ' 
      End With 
     End If 

    '~~> If file is not open 
    Else 
     On Error Resume Next 
     Set oXLApp = GetObject(, "Excel.Application") 

     '~~> If not found then create new instance 
     If Err.Number <> 0 Then 
      Set oXLApp = CreateObject("Excel.Application") 
     End If 
     Err.Clear 
     On Error GoTo 0 

     Set wb = oXLApp.Workbooks.Open(SFile) 
     ' 
     '~~> Rest of the code 
     ' 
    End If 
End Sub 

Private Sub SetIDispatch(ByRef ID As GUID) 
    With ID 
     .lData1 = &H20400 
     .iData2 = &H0 
     .iData3 = &H0 
     .aBData4(0) = &HC0 
     .aBData4(1) = &H0 
     .aBData4(2) = &H0 
     .aBData4(3) = &H0 
     .aBData4(4) = &H0 
     .aBData4(5) = &H0 
     .aBData4(6) = &H0 
     .aBData4(7) = &H46 
    End With 
End Sub 

'~~> Function to check if file is open 
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 
+0

좋습니다. 나는 그것을 시도 할 것이다. 도와 주신 Siddharth에게 정말 고마워요. –

+0

마지막 매개 변수로 sFileName을 사용하려면'cWnd = FindWindowEx (mWnd, 0 &, "EXCEL7", filewithoutExt)'를 변경하면 완벽하게 작동합니다. 다시 한번 감사드립니다. –

+0

마지막으로 한가지 생각 ...'전화 AccessibleObjectFromWindow (CWND, OBJID_NATIVEOM, IDispatch를, WB)이'내가 DocNo의 값에 따라 워크 시트 개체에 링크 할 후 (사용'xlSheet = ...'설정). 'With'구조에서이 작업을 수행하는 방법을 잘 모르겠습니다. 이 작업을 수행하거나 통합 문서 개체에 직접 연결하는 방법이 있습니까 (예 : Set xlBook = xlApp.Workbooks ("File Index.xlsx") 또는 무엇인가). 고맙습니다! 여기 많이 배우고 있습니다 :) –

1

Excel 파일이 열려 있는지 확인하려면이 기능을 사용할 수 있습니다.

Sub Sample() 
    Dim Ret 
    Dim sFile As String 

    sFile = "C:\Users\Chris\Desktop\Data.xlsx" 
    Ret = IsWorkBookOpen(sFile) 

    If Ret = True Then 
     MsgBox "File is Open" 
    Else 
     MsgBox "File is not Open" 
    End If 
End Sub 

'~~> Function to check if file is open 
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 
+0

쿨, 고마워. 그건 깔끔하게 작동합니다. 현재 사용자가 열 었는지 또는 다른 사용자가 열 었는지 찾는 문제는 여전히 있습니다. 난 그냥 지금이 발견,하지만 난 그것을 테스트하기 위해 아직 : [통합 문서가 어떤 엑셀 인스턴스에서 열려 있으면 확인] (http://www.thecodenet.com/articles.php?id=1) –

+0

난 사실에 대답 귀하의 다른 게시물하지만 그것을 삭제 :) 나는 그 게시물을 여기에 얻을 것이다 :) –

+0

별도의 답변으로 게시 됨. :) –

0

참조입니다 그것은 열려

Public Shared Function isFileAlreadyOpen(ByVal xlFileName As String) As Boolean 
    Return CBool(Not getIfBookOpened(xlFileName) Is Nothing) 
End Function 

Public Shared Function getIfBookOpened(ByVal xlFileName As String) As Excel.Workbook 
    Dim wbBook As Excel.Workbook 
    Dim xlProcs() As Process = Process.GetProcessesByName("EXCEL") 
    If xlProcs.Count > 0 Then 
     Dim xlApp As Excel.Application = CType(System.Runtime.InteropServices.Marshal.GetActiveObject("Excel.Application"), Excel.Application) 
     For Each wbBook In xlApp.Workbooks 
      If wbBook.FullName.ToUpper = xlFileName.ToUpper Then 
       Return wbBook 
       Exit For 
      End If 
     Next 
    End If 
    Return Nothing 
End Function 

또는

Public Shared Function getOrOpenBook(ByVal xlFileName As String) As Excel.Workbook 
    Return System.Runtime.InteropServices.Marshal.BindToMoniker(xlFileName) 
End Function 
관련 문제