Select ExecutablePath FROM Win32_Process WHERE CommandLine Like '%Буква диска:\\Путь\\к\\файлу%'wildwolf007
Чтобы не было лишних вопросов:
Path = "X:\\Файл.ext"
Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
For Each F in WMI.ExecQuery("SELECT ExecutablePath FROM Win32_Process WHERE CommandLine Like '%" & Path & "%'")
MsgBox "Файл открыт приложением: " & vbNewLine & F.ExecutablePath, 64, Space(13) & "Проверка запуска файла"
Next : Set WMI = Nothing…если открытый файл находится на USB накопителе или в "простонародии" на флешке, то данный метод нельзя применять.
У меня работает.
Возможно, причина в
1) используемом накопителе (способе его подключения, драйвере…) или
2) программа, открывающая файл, не блокирует его, если он находится на съёмном носителе.
Для проверки, действительно ли заблокирован файл попробуйте ввести в командной строке
rem:>>"G:\1234.rtf"или
set /p=<nul>>"G:\1234.rtf"— должно ответить
Процесс не может получить доступ к файлу, так как этот файл занят другим процессом.
или просто попробуйте изменить файл в Блокноте…
Чтобы самому заблокировать файл введите в командной строке
(pause>con)>>"G:\1234.rtf"— файл будет заблокирован на время паузы.
]]>Теперь пишет разрешение отклонено.
Dim objFso
Set objFso = CreateObject("Scripting.FileSystemObject")
MsgBox "Код ошибки до Err.Number = " &Err.Number
On Error Resume Next
Dim OpenFileBuzyCheck
Set OpenFileBuzyCheck = objFso.OpenTextFile("C:\12345671.rtf", 8, True)
MsgBox "Err.Number = После открытия на дозапись = " &Err.Number
MsgBox "err.description" &err.description
If Err.Number > 0 Then
MsgBox "Файл занят" &"Err.Number = " &Err.Number
MsgBox "Сработало условие Err.Number = " &Err.Number
End IF
Err.Clear
MsgBox "Err.Number = Проверка кода ошибки после чистки " &Err.Number
OpenFileBuzyCheck.Close
On Error Goto 0
Пишет: "Требуется объект".
Возможно, что ошибку проверять надо до закрытия файла?
]]>
Dim objFso
Set objFso = CreateObject("Scripting.FileSystemObject")
MsgBox "Код ошибки до Err.Number = " &Err.Number
On Error Resume Next
Dim OpenFileBuzyCheck
Set OpenFileBuzyCheck = objFso.OpenTextFile("C:\12345671.rtf", 8, True)
OpenFileBuzyCheck.Close
MsgBox "Err.Number = После открытия на дозапись = " &Err.Number
If Err.Number > 0 Then
MsgBox "Файл занят" &"Err.Number = " &Err.Number
MsgBox "Сработало условие Err.Number = " &Err.Number
End IF
Err.Clear
MsgBox "Err.Number = Проверка кода ошибки после чистки " &Err.Number
On Error Goto 0
А если файл будет EXE ?
В чём разница? Проверка работает (код ошибки 70, если файл занят).
]]>К тому же в Windows 7 на примере Doc, можно переименовать открытые файлы Office 2010.
Открываем файл doc в ворде и переименовываем файл и все проходит корректно, только когда потом пытаешься произвести сохранение документа ворд говорит "Убедитесь, что задвижка дисковода закрыта и он содержит правильный диск "
Кто что-нибудь может подсказать?
MsgBox File.Name
MsgBox "Err.Number = " &Err.Number
On Error Resume Next
File.Name = File.Name
MsgBox "Err.Number = " &Err.Number
On Error Goto 0