Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Проверка открыт ли другим пользователем файл Word в макросе Excel
 
#1
29.10.2011 00:16:31
Доброго времени суток! Есть небольшая проблемка: при открытии файла word, если он уже открыт другим пользователем появляется окно запроса "Открыть только для чтения и т. д." блокировка окон не помогает. Как сделать так, чтобы окно не появлялось? Проверка открыт или нет идёт далее, вот пример кода:  
 
Sub test()  
   Dim objWord As Object  
   Set objWord = CreateObject("Word.Application")  
   With objWord  
       .DisplayAlerts = -2  
       On Error GoTo zakr:  
       .documents.Open Filename:="D:\123.doc", ReadOnly:=False  
       On Error GoTo 0  
       If .documents("123.doc").ReadOnly = True Then GoTo opa:  
       ' дополнение файла word  
       .ActiveDocument.Save  
       .DisplayAlerts = 0  
   End With  
zakr:  
   objWord.Quit  
   Set objWord = Nothing  
   MsgBox "Файл не найден!", vbCritical, ActiveWorkbook.Name  
   Exit Sub  
opa:  
   objWord.Quit  
   Set objWord = Nothing  
   MsgBox "Файл занят другим пользователем!", vbCritical, ActiveWorkbook.Name  
End Sub
 
 
 
#2
29.10.2011 00:48:04
Извиняюсь, перед ссылкой "zakr:" надо вставить строчку "exit sub".
 
 
 
#3
29.10.2011 01:13:39
прикрепил файлы:
 
 
 
#4
29.10.2011 01:30:34
Файл не смотрел, но попробуйте так:  
Public Sub www()  
Dim oWD As Object  
Set oWD = GetObject("D:\123.doc")  
oWD.Windows(1).Visible = True'это не обязательно, лучше со скрытым, а показать только перед сохранением.  
End Sub
Я сам - дурнее всякого примера! ...
 
 
 
#5
29.10.2011 01:33:51
Sub Test()  
   
 Const DocFile$ = "D:\123.doc"  
 Const MyDebug As Boolean = True ' Флаг отладки  
   
 ' Проверить  занятость файла  
 If IsOpen(DocFile) Then  
   MsgBox "Файл занят другим пользователем!", vbCritical, DocFile  
   Exit Sub  
 End If  
   
 Dim objWord As Object, IsNewApp As Boolean  
   
 ' Попытаться использовать ранее открытое приложение WinWord (это быстрее)  
 On Error Resume Next  
 Set objWord = GetObject(, "Word.Application")  
 If Err Then  
   ' Открытое приложение WinWord не нвйдено - создать новое  
   Set objWord = CreateObject("Word.Application")  
   IsNewApp = True  
 End If  
 On Error GoTo exit_  
   
 ' Открыть документ DocFile  
 With objWord  
   If MyDebug Then .Visible = True  '<-- для отладки  
   With .Documents.Open(DocFile)  
     ' Что-то сделать с документом  
     .Content.Font.Name = "Arial"  
     ' ...  
     .Close True  
   End With  
   If IsNewApp Then .Quit  
 End With  
   
exit_:  
   
 ' Обязательно освободить память, занимаемую объектной переменной  
 Set objWord = Nothing  
   
 ' При ошибке - сообщить  
 If Err Then MsgBox Err.Description, vbCritical, "Ошибка"  
   
End Sub  
 
Function IsOpen(File$) As Boolean  
 Dim FN%  
 FN = FreeFile  
 On Error Resume Next  
 Open File For Random Access Read Write Lock Read Write As #FN  
 Close #FN  
 IsOpen = Err  
End Function
 
 
 
#6
29.10.2011 01:44:04
Большое СПАСИБО!!! Всё заработало! Пример на УРА, буду встраивать в свой код и отдельные решения пригодяться, чтобы разгрузить другие части кода.  
Ещё раз большое СПАСИБО!!!
 
 
 
Страницы: 1
Читают тему
Наверх