Как узнать, открыт ли Excel?

[Trusishka]

Мне нужно знать открыт кем-либо нужный мне Excel файл.

[Sedge]

Код: Выделить всё


Private Declare Function FindWindowByClass Lib "user32" _
   Alias "FindWindowA" (ByVal lpClassName As String, _
   ByVal lpWindowName As Long) As Long

Public Function IsWorBookOpen(wbName As String) As Boolean
'
On Error GoTo eRes

'//////////////////////////////////////////////////////////////////////////////////////
  Dim lRes As Long, objExcel As Object
  Dim wbCurrent As Object
'//////////////////////////////////////////////////////////////////////////////////////

lRes = FindWindowByClass("XLMAIN", 0&)

If lRes <> 0 Then
  Set objExcel = GetObject(, "Excel.Application")
Else
  IsWorBookOpen = False
  Exit Function
End If

For Each wbCurrent In objExcel.Workbooks
  If LCase(wbCurrent.Name) = LCase(wbName) Then
    IsWorBookOpen = True
    Exit Function
  End If
Next

IsWorBookOpen = False
Exit Function
eRes:
  Call Err.Raise(Err.Number, "IsWorBookOpen", Err.Description)
End Function

Private Sub Command1_Click()

  MsgBox (IsWorBookOpen("test.xls"))

End Sub




[Trusishka]

почему-то, даже если книга открыта показывает "False"

[Sedge]

1. Какой офис?
2. Имя рабочей книги надо передавать абсолютно точно, без пути и с расширением.

Тестировалось на Office 2000. Код рабочий.

[Trusishka]

без пути

ура, заработало, спасибо , я передавал с путем.
а этот код разве будет работать, если файл лежит на сети?

[Sedge]

Стоп. Тебе надо проверить открыт ли файл по сети? Если да, то конечно нет
Надо было точнее вопрос формулировать.

[Trusishka]

Стоп. Тебе надо проверить открыт ли файл по сети? Если да, то конечно нет
Надо было точнее вопрос формулировать.

ага, извини, мне надо по сети, чтобы можно было путь указывать.

[Sedge]

Попробуй вот это.

Код: Выделить всё

Public Function IsWorkBookOpen(wbPath As String) As Boolean
'
On Error GoTo eRes

'//////////////////////////////////////////////////////////////////////////////////////
  Dim objExcel As Object
  Dim vArray As Variant, sWBName As String
'//////////////////////////////////////////////////////////////////////////////////////

vArray = Split(wbPath, "\", , vbTextCompare)
sWBName = vArray(UBound(vArray))
Set objExcel = CreateObject("Excel.Application")
With objExcel
  .Workbooks.Open (wbPath)
  With Workbooks(sWBName)
    IsWorkBookOpen = .ReadOnly
    .Saved = True
  End With
  .Quit
End With
Set objExcel = Nothing

Exit Function
eRes:
  Call Err.Raise(Err.Number, "IsWorkBookOpen", Err.Description)
End Function

Private Sub Command1_Click()

  MsgBox IsWorkBookOpen("D:\common\test2.xls")

End Sub


[Trusishka]

как-то косячит при нажатии на кнопку в памяти открывается невидимый файл Excel , а при втором нажатии на кнопку вылазит ошибка "out of range"

[Sedge]

Да, действительно Ладно, сейчас попробую разобраться...

[Sedge]

В общем выкинь все что я до этого написал. Вот оно - Дао :

Код: Выделить всё

Public Function IsWorkBookOpen(wbPath As String) As Boolean
'
On Error Resume Next

Open wbPath For Input Lock Read As #1
Close #1
IsWorkBookOpen = Err.Number <> 0

End Function


[Trusishka]

свершилось чудо, друг спас жизнь друга ! Огроменное спасибо, за такое внимание к моей проблеме